66 lines
3.0 KiB
Mathematica
66 lines
3.0 KiB
Mathematica
PRC5B2 ;WISC/PLT-PRC5B1 continue ;7/30/94 03:07
|
|
V ;;5.0;IFCAP;;4/21/95
|
|
QUIT ;invalid entry
|
|
;
|
|
CPF ;fill-in fms fields in file 420 (fcp file) (called from prc5a)
|
|
N PRCRI,PRCA,PRCB,PRCC
|
|
D EN^DDIOL("POST INITIAL: Process FMS CPF-DOCUMENT"_" at "_$$NOW^PRC5A)
|
|
S PRCSTRI=$O(^PRCD(420.1999,"AC","A",""))
|
|
S PRCRI(420.92)=0
|
|
F S PRCRI(420.92)=$O(^PRCU(420.92,"B","CPF",PRCRI(420.92))) Q:'PRCRI(420.92) S PRCA=^PRCU(420.92,PRCRI(420.92),0) D:$P(PRCA,"^",4)]""&($P(PRCA,"^",6)="")
|
|
. D ED^PRC5B1(PRCRI(420.92),1)
|
|
. S PRCRI(420.923)=0
|
|
. F S PRCRI(420.923)=$O(^PRCU(420.92,PRCRI(420.92),1,PRCRI(420.923))) Q:'PRCRI(420.923) D:$P(^(PRCRI(420.923),0),"^",2)="" CPFED(PRCRI(420.92),PRCRI(420.923))
|
|
. D ED^PRC5B1(PRCRI(420.92),2)
|
|
D EN^DDIOL("POST INITIAL: Process FMS CPF-DOCUMENT done!"_" at "_$$NOW^PRC5A)
|
|
QUIT
|
|
;
|
|
CPFED(PRCA,PRCB) ;start conver fcp
|
|
N PRCRI,PRCBY,PRCAO,PRCALD,PRCPGM,PRCFCP,PRCOB,PRCJOB,PRCSCP,PRCFUND
|
|
N PRC,PRCDD,PRCDR,PRCDI,PRCPR,PRCAED,PRCQT,PRCU S PRCU="^"
|
|
N PRCK,PRCLOCK,PRCNO,PRCST,PRCUNQ
|
|
N DA,A,B,X,Y
|
|
N PRCUQ,PRCK1,PRCK26,PRCK28,PRCK29,PRCK25,PRCK25D5,PRCK27
|
|
N PRCF,PRCFA,PRCFUND,PRCBBFY,PRCRQ
|
|
S A=^PRCU(420.92,PRCA,1,PRCB,1),PRCSCP=""
|
|
S PRCALD=$P(A,"~",2),PRCBY=$P(A,"~",3),PRCYEAR=+$$YEAR^PRC0C(PRCBY)
|
|
S PRCFUND=$P(A,"~",5)
|
|
S PRCRI(420)=+$P(A,"~",7),PRCAO=$P(A,"~",6),PRCPGM=$P(A,"~",8),PRCFCP=$P(A,"~",9)
|
|
S PRCOB=$P(A,"~",10),PRCJOB=$P(A,"~",11),PRCRI(420.01)=$P(A,"~",12)
|
|
QUIT:'PRCRI(420)!(PRCRI(420.01)="")
|
|
QUIT:'$D(^PRC(420,PRCRI(420),0))
|
|
I PRCRI(420.01)="GPFS" S PRCSCP=1 D
|
|
. S PRCRI(420.01)=$O(^PRC(420,PRCRI(420),1,"C","GPFS FMS CONVERSION",""))
|
|
. QUIT:PRCRI(420.01)
|
|
. F B=9998:-1:1 QUIT:'$D(^PRC(420,PRCRI(420),1,B))
|
|
. QUIT:B=1
|
|
. S PRCDI="420;^PRC(420,;"_PRCRI(420)_";1~420.01;^PRC(420,"_PRCRI(420)_",1,"
|
|
. S X=$E(10000+B,2,999)_" GPFS FMS CONVERSION"
|
|
. D ADD^PRC0B1(.X,.Y,PRCDI,+X)
|
|
. S PRCRI(420.01)=+Y
|
|
. QUIT
|
|
QUIT:'PRCRI(420.01)
|
|
S PRCRI(420.01)=+PRCRI(420.01)
|
|
QUIT:'$D(^PRC(420,PRCRI(420),1,PRCRI(420.01)))
|
|
I PRCAO]"" S PRCAO=$O(^PRCD(420.15,"B",PRCAO,"")) QUIT:'PRCAO
|
|
I PRCPGM]"" S PRCPGM=$O(^PRCD(420.13,"B",PRCPGM,"")) QUIT:'PRCPGM
|
|
I PRCFCP]"" S PRCFCP=$O(^PRCD(420.131,"B",PRCFCP,"")) QUIT:'PRCFCP
|
|
I PRCOB]"" S PRCOB=$O(^PRCD(420.132,"B",PRCOB,"")) QUIT:'PRCOB
|
|
I PRCJOB]"" S PRCJOB=$O(^PRCD(420.133,"B",PRCJOB,"")) QUIT:'PRCJOB
|
|
S PRCRI(420.3)=0 F S PRCRI(420.3)=$O(^PRCD(420.3,"B",PRCFUND,PRCRI(420.3))) Q:'PRCRI(420.3) Q:$P($G(^PRCD(420.3,PRCRI(420.3),0)),"^",6)=""
|
|
QUIT:'PRCRI(420.3)
|
|
S PRCDI="420;^PRC(420,;"_PRCRI(420)_"~420.01;^PRC(420,"_PRCRI(420)_",1,;"_PRCRI(420.01)
|
|
S PRCDD=420.01
|
|
D KEY1^PRCB1A,REQ1^PRCB1A1
|
|
S X="1////"_PRCRI(420.3)_";25.2///^S X="_PRCBY_";25.5////"_PRCAO_";26////"_PRCPGM_";27////"_PRCFCP_";28////"_PRCOB_";29////"_PRCJOB
|
|
S:PRCSCP=1 X(1,420.01,1)="4////Y;12////Y;13////"_PRCSCP_";14////0"
|
|
D EDIT^PRC0B(.X,PRCDI,"") K X
|
|
;add entry in file 420d141
|
|
S B=$$ACC^PRC0C(PRCRI(420),PRCRI(420.01)_"^"_PRCBY_"^"_PRCYEAR)
|
|
S A=$$FMSACC^PRC0D(PRCRI(420),B)
|
|
I '$$FIRST^PRC0B1("^PRCD(420.141,""B"","""_A_""",",0) S X=$$A420D141^PRC0F(A,PRCRI(420.01))
|
|
D ED1^PRC5B1(PRCA,PRCB) ;edit convert field
|
|
QUIT
|
|
;
|
|
;
|