| 1 | PRC5B2 ;WISC/PLT-PRC5B1 continue ;7/30/94 03:07
|
|---|
| 2 | V ;;5.0;IFCAP;;4/21/95
|
|---|
| 3 | QUIT ;invalid entry
|
|---|
| 4 | ;
|
|---|
| 5 | CPF ;fill-in fms fields in file 420 (fcp file) (called from prc5a)
|
|---|
| 6 | N PRCRI,PRCA,PRCB,PRCC
|
|---|
| 7 | D EN^DDIOL("POST INITIAL: Process FMS CPF-DOCUMENT"_" at "_$$NOW^PRC5A)
|
|---|
| 8 | S PRCSTRI=$O(^PRCD(420.1999,"AC","A",""))
|
|---|
| 9 | S PRCRI(420.92)=0
|
|---|
| 10 | 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)="")
|
|---|
| 11 | . D ED^PRC5B1(PRCRI(420.92),1)
|
|---|
| 12 | . S PRCRI(420.923)=0
|
|---|
| 13 | . 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))
|
|---|
| 14 | . D ED^PRC5B1(PRCRI(420.92),2)
|
|---|
| 15 | D EN^DDIOL("POST INITIAL: Process FMS CPF-DOCUMENT done!"_" at "_$$NOW^PRC5A)
|
|---|
| 16 | QUIT
|
|---|
| 17 | ;
|
|---|
| 18 | CPFED(PRCA,PRCB) ;start conver fcp
|
|---|
| 19 | N PRCRI,PRCBY,PRCAO,PRCALD,PRCPGM,PRCFCP,PRCOB,PRCJOB,PRCSCP,PRCFUND
|
|---|
| 20 | N PRC,PRCDD,PRCDR,PRCDI,PRCPR,PRCAED,PRCQT,PRCU S PRCU="^"
|
|---|
| 21 | N PRCK,PRCLOCK,PRCNO,PRCST,PRCUNQ
|
|---|
| 22 | N DA,A,B,X,Y
|
|---|
| 23 | N PRCUQ,PRCK1,PRCK26,PRCK28,PRCK29,PRCK25,PRCK25D5,PRCK27
|
|---|
| 24 | N PRCF,PRCFA,PRCFUND,PRCBBFY,PRCRQ
|
|---|
| 25 | S A=^PRCU(420.92,PRCA,1,PRCB,1),PRCSCP=""
|
|---|
| 26 | S PRCALD=$P(A,"~",2),PRCBY=$P(A,"~",3),PRCYEAR=+$$YEAR^PRC0C(PRCBY)
|
|---|
| 27 | S PRCFUND=$P(A,"~",5)
|
|---|
| 28 | S PRCRI(420)=+$P(A,"~",7),PRCAO=$P(A,"~",6),PRCPGM=$P(A,"~",8),PRCFCP=$P(A,"~",9)
|
|---|
| 29 | S PRCOB=$P(A,"~",10),PRCJOB=$P(A,"~",11),PRCRI(420.01)=$P(A,"~",12)
|
|---|
| 30 | QUIT:'PRCRI(420)!(PRCRI(420.01)="")
|
|---|
| 31 | QUIT:'$D(^PRC(420,PRCRI(420),0))
|
|---|
| 32 | I PRCRI(420.01)="GPFS" S PRCSCP=1 D
|
|---|
| 33 | . S PRCRI(420.01)=$O(^PRC(420,PRCRI(420),1,"C","GPFS FMS CONVERSION",""))
|
|---|
| 34 | . QUIT:PRCRI(420.01)
|
|---|
| 35 | . F B=9998:-1:1 QUIT:'$D(^PRC(420,PRCRI(420),1,B))
|
|---|
| 36 | . QUIT:B=1
|
|---|
| 37 | . S PRCDI="420;^PRC(420,;"_PRCRI(420)_";1~420.01;^PRC(420,"_PRCRI(420)_",1,"
|
|---|
| 38 | . S X=$E(10000+B,2,999)_" GPFS FMS CONVERSION"
|
|---|
| 39 | . D ADD^PRC0B1(.X,.Y,PRCDI,+X)
|
|---|
| 40 | . S PRCRI(420.01)=+Y
|
|---|
| 41 | . QUIT
|
|---|
| 42 | QUIT:'PRCRI(420.01)
|
|---|
| 43 | S PRCRI(420.01)=+PRCRI(420.01)
|
|---|
| 44 | QUIT:'$D(^PRC(420,PRCRI(420),1,PRCRI(420.01)))
|
|---|
| 45 | I PRCAO]"" S PRCAO=$O(^PRCD(420.15,"B",PRCAO,"")) QUIT:'PRCAO
|
|---|
| 46 | I PRCPGM]"" S PRCPGM=$O(^PRCD(420.13,"B",PRCPGM,"")) QUIT:'PRCPGM
|
|---|
| 47 | I PRCFCP]"" S PRCFCP=$O(^PRCD(420.131,"B",PRCFCP,"")) QUIT:'PRCFCP
|
|---|
| 48 | I PRCOB]"" S PRCOB=$O(^PRCD(420.132,"B",PRCOB,"")) QUIT:'PRCOB
|
|---|
| 49 | I PRCJOB]"" S PRCJOB=$O(^PRCD(420.133,"B",PRCJOB,"")) QUIT:'PRCJOB
|
|---|
| 50 | 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)=""
|
|---|
| 51 | QUIT:'PRCRI(420.3)
|
|---|
| 52 | S PRCDI="420;^PRC(420,;"_PRCRI(420)_"~420.01;^PRC(420,"_PRCRI(420)_",1,;"_PRCRI(420.01)
|
|---|
| 53 | S PRCDD=420.01
|
|---|
| 54 | D KEY1^PRCB1A,REQ1^PRCB1A1
|
|---|
| 55 | S X="1////"_PRCRI(420.3)_";25.2///^S X="_PRCBY_";25.5////"_PRCAO_";26////"_PRCPGM_";27////"_PRCFCP_";28////"_PRCOB_";29////"_PRCJOB
|
|---|
| 56 | S:PRCSCP=1 X(1,420.01,1)="4////Y;12////Y;13////"_PRCSCP_";14////0"
|
|---|
| 57 | D EDIT^PRC0B(.X,PRCDI,"") K X
|
|---|
| 58 | ;add entry in file 420d141
|
|---|
| 59 | S B=$$ACC^PRC0C(PRCRI(420),PRCRI(420.01)_"^"_PRCBY_"^"_PRCYEAR)
|
|---|
| 60 | S A=$$FMSACC^PRC0D(PRCRI(420),B)
|
|---|
| 61 | I '$$FIRST^PRC0B1("^PRCD(420.141,""B"","""_A_""",",0) S X=$$A420D141^PRC0F(A,PRCRI(420.01))
|
|---|
| 62 | D ED1^PRC5B1(PRCA,PRCB) ;edit convert field
|
|---|
| 63 | QUIT
|
|---|
| 64 | ;
|
|---|
| 65 | ;
|
|---|
