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
 ;
 ;