- PRC5B1 ;WISC/PLT-PRC5B continue ; 07/07/94 2:47 PM
- V ;;5.0;IFCAP;;4/21/95
- QUIT ;invalid entry
- ;
- ALD ;called by PRC5B
- N PRCA,PRCB,PRCC
- D EN^DDIOL("POST INITIAL: Move name (.01) to ald (5) for file 420.3"_" at "_$$NOW^PRC5A)
- S PRCA=0 F S PRCA=$O(^PRCD(420.3,PRCA)) Q:'PRCA S PRCB=^(PRCA,0) D:$P(PRCB,"^",7)=""&($P(PRCB,"^",6)="")
- . S PRCC=$P(PRCB,"^")
- . D EDIT^PRC0B(.X,"420.3;;"_PRCA,"5///^S X="""_PRCC_"""")
- . QUIT
- D EN^DDIOL("POST INITIAL: Move name (.01) to ald (5) for file 420.3 DONE"_" at "_$$NOW^PRC5A)
- QUIT
- ;
- FND ;add fund code to file 420.3
- N PRCRI,PRCA,PRCB,PRCC,PRCSTRI
- D EN^DDIOL("POST INITIAL: Process FMS FND-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","FND",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(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)="" FNDED(PRCRI(420.92),PRCRI(420.923))
- . D ED(PRCRI(420.92),2)
- D EN^DDIOL("POST INITIAL: Process FMS FND-DOCUMENT done!"_" at "_$$NOW^PRC5A)
- QUIT
- ;
- FNDED(PRCA,PRCB) ;start convert
- N PRCRI,PRCAPP,PRCFUND,PRCFUNDD,PRCYB,PRCYE,A
- S A=^PRCU(420.92,PRCA,1,PRCB,1),PRCAPP=$P(A,"~",2),PRCFUND=$P(A,"~",5)
- S PRCYB=+$$YEAR^PRC0C($P(A,"~",3)),PRCYE=+$$YEAR^PRC0C($S($P(A,"~",4):$P(A,"~",4),1:PRCYB)),PRCFUNDD=$P(A,"~",6)
- Q:PRCAPP=""!(PRCFUND="")!'PRCYB!'PRCYE
- ;add/edit fund file 420.14
- S PRCRI(420.14)=$O(^PRCD(420.14,"UNQ",PRCFUND,PRCYB,PRCYE,"")) D QUIT:'PRCRI(420.14)
- . I PRCRI(420.14) D EDIT^PRC0B(.X,"420.14;;"_PRCRI(420.14),"1///^S X="""_PRCFUNDD_"""") I 1
- . E S (PRCUQ,PRCK01,PRCK2,PRCK3)="" D
- .. S X=PRCFUND,X("DR")="1////"_PRCFUNDD_";2///^S X="""_PRCYB_""";3///^S X="""_PRCYE_""";5////"_PRCSTRI
- .. D ADD^PRC0B1(.X,.Y,"420.14;^PRCD(420.14,")
- .. S:Y>0 PRCRI(420.14)=+Y
- .. Q
- . Q
- 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)=""
- I 'PRCRI(420.3) D QUIT:'PRCRI(420.3)
- . S X=PRCFUND,X("DR")="2////"_PRCAPP_";4////"_$TR(PRCAPP,"_"," ")
- . D ADD^PRC0B1(.X,.Y,"420.3;^PRCD(420.3,")
- . S:Y>0 PRCRI(420.3)=+Y
- D ED1(PRCA,PRCB) ;edit convert field
- QUIT
- ;
- PCL ;set-up program dic (called from prc5a)
- N PRCRI,PRCA,PRCB,PRCC,PRCSTRI
- D EN^DDIOL("POST INITIAL: Process FMS PCL-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","PCL",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(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)="" PCLED(PRCRI(420.92),PRCRI(420.923))
- . D ED(PRCRI(420.92),2)
- D EN^DDIOL("POST INITIAL: Process FMS PCL-DOCUMENT done!"_" at "_$$NOW^PRC5A)
- QUIT
- ;
- PCLED(PRCA,PRCB) ;set-up program dic
- N PRCRI,PRCPGM,PRCPGMD,A
- S A=^PRCU(420.92,PRCA,1,PRCB,1),PRCPGM=$P(A,"~",3),PRCPGMD=$P(A,"~",4)
- Q:PRCPGM=""
- S PRCRI(420.13)=$O(^PRCD(420.13,"B",PRCPGM,""))
- I PRCRI(420.13)="" D QUIT:'PRCRI(420.13)
- . N X,Y
- . S X=PRCPGM,X("DR")="1////"_PRCPGMD_";2////"_PRCSTRI
- . D ADD^PRC0B1(.X,.Y,"420.13;^PRCD(420.13,")
- . S:Y>0 PRCRI(420.13)=+Y
- . QUIT
- D ED1(PRCA,PRCB) ;edit convert field
- QUIT
- ;
- PAC ;set-up fcp/prj dic (called by prc5a)
- G PAC^PRC5B3
- QUIT
- ;
- CPF ;fill-in fms fields in file 420 (fcp file) (called from prc5a)
- G CPF^PRC5B2
- ;
- QUIT
- ;
- ED(PRCA,PRCB) ;edit convert start/end time,PRCA=RI, PRCB=1 if start, 2 if end
- S PRCB=$S(PRCB=1:2.6,1:2.7)
- D EDIT^PRC0B(.X,"420.92;;"_PRCA,PRCB_"///^S X=""N""")
- QUIT
- ;
- ED1(PRCA,PRCB) ;edit converted y/n
- N A
- S A="420.92;^PRCU(420.92,;"_PRCA
- S A=A_"~"_"420.923;^PRCU(420.92,"_PRCA_",1,;"_PRCB
- D EDIT^PRC0B(.X,A,"2////Y")
- QUIT
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRC5B1 4023 printed Dec 13, 2024@01:59:49 Page 2
- PRC5B1 ;WISC/PLT-PRC5B continue ; 07/07/94 2:47 PM
- V ;;5.0;IFCAP;;4/21/95
- +1 ;invalid entry
- QUIT
- +2 ;
- ALD ;called by PRC5B
- +1 NEW PRCA,PRCB,PRCC
- +2 DO EN^DDIOL("POST INITIAL: Move name (.01) to ald (5) for file 420.3"_" at "_$$NOW^PRC5A)
- +3 SET PRCA=0
- FOR
- SET PRCA=$ORDER(^PRCD(420.3,PRCA))
- if 'PRCA
- QUIT
- SET PRCB=^(PRCA,0)
- if $PIECE(PRCB,"^",7)=""&($PIECE(PRCB,"^",6)="")
- Begin DoDot:1
- +4 SET PRCC=$PIECE(PRCB,"^")
- +5 DO EDIT^PRC0B(.X,"420.3;;"_PRCA,"5///^S X="""_PRCC_"""")
- +6 QUIT
- End DoDot:1
- +7 DO EN^DDIOL("POST INITIAL: Move name (.01) to ald (5) for file 420.3 DONE"_" at "_$$NOW^PRC5A)
- +8 QUIT
- +9 ;
- FND ;add fund code to file 420.3
- +1 NEW PRCRI,PRCA,PRCB,PRCC,PRCSTRI
- +2 DO EN^DDIOL("POST INITIAL: Process FMS FND-DOCUMENT"_" at "_$$NOW^PRC5A)
- +3 SET PRCSTRI=$ORDER(^PRCD(420.1999,"AC","A",""))
- +4 SET PRCRI(420.92)=0
- FOR
- SET PRCRI(420.92)=$ORDER(^PRCU(420.92,"B","FND",PRCRI(420.92)))
- if 'PRCRI(420.92)
- QUIT
- SET PRCA=^PRCU(420.92,PRCRI(420.92),0)
- if $PIECE(PRCA,"^",4)]""&($PIECE(PRCA,"^",6)="")
- Begin DoDot:1
- +5 DO ED(PRCRI(420.92),1)
- +6 SET PRCRI(420.923)=0
- +7 FOR
- SET PRCRI(420.923)=$ORDER(^PRCU(420.92,PRCRI(420.92),1,PRCRI(420.923)))
- if 'PRCRI(420.923)
- QUIT
- if $PIECE(^(PRCRI(420.923),0),"^",2)=""
- DO FNDED(PRCRI(420.92),PRCRI(420.923))
- +8 DO ED(PRCRI(420.92),2)
- End DoDot:1
- +9 DO EN^DDIOL("POST INITIAL: Process FMS FND-DOCUMENT done!"_" at "_$$NOW^PRC5A)
- +10 QUIT
- +11 ;
- FNDED(PRCA,PRCB) ;start convert
- +1 NEW PRCRI,PRCAPP,PRCFUND,PRCFUNDD,PRCYB,PRCYE,A
- +2 SET A=^PRCU(420.92,PRCA,1,PRCB,1)
- SET PRCAPP=$PIECE(A,"~",2)
- SET PRCFUND=$PIECE(A,"~",5)
- +3 SET PRCYB=+$$YEAR^PRC0C($PIECE(A,"~",3))
- SET PRCYE=+$$YEAR^PRC0C($SELECT($PIECE(A,"~",4):$PIECE(A,"~",4),1:PRCYB))
- SET PRCFUNDD=$PIECE(A,"~",6)
- +4 if PRCAPP=""!(PRCFUND="")!'PRCYB!'PRCYE
- QUIT
- +5 ;add/edit fund file 420.14
- +6 SET PRCRI(420.14)=$ORDER(^PRCD(420.14,"UNQ",PRCFUND,PRCYB,PRCYE,""))
- Begin DoDot:1
- +7 IF PRCRI(420.14)
- DO EDIT^PRC0B(.X,"420.14;;"_PRCRI(420.14),"1///^S X="""_PRCFUNDD_"""")
- IF 1
- +8 IF '$TEST
- SET (PRCUQ,PRCK01,PRCK2,PRCK3)=""
- Begin DoDot:2
- +9 SET X=PRCFUND
- SET X("DR")="1////"_PRCFUNDD_";2///^S X="""_PRCYB_""";3///^S X="""_PRCYE_""";5////"_PRCSTRI
- +10 DO ADD^PRC0B1(.X,.Y,"420.14;^PRCD(420.14,")
- +11 if Y>0
- SET PRCRI(420.14)=+Y
- +12 QUIT
- End DoDot:2
- +13 QUIT
- End DoDot:1
- if 'PRCRI(420.14)
- QUIT
- +14 SET PRCRI(420.3)=0
- FOR
- SET PRCRI(420.3)=$ORDER(^PRCD(420.3,"B",PRCFUND,PRCRI(420.3)))
- if 'PRCRI(420.3)
- QUIT
- if $PIECE($GET(^PRCD(420.3,PRCRI(420.3),0)),"^",6)=""
- QUIT
- +15 IF 'PRCRI(420.3)
- Begin DoDot:1
- +16 SET X=PRCFUND
- SET X("DR")="2////"_PRCAPP_";4////"_$TRANSLATE(PRCAPP,"_"," ")
- +17 DO ADD^PRC0B1(.X,.Y,"420.3;^PRCD(420.3,")
- +18 if Y>0
- SET PRCRI(420.3)=+Y
- End DoDot:1
- if 'PRCRI(420.3)
- QUIT
- +19 ;edit convert field
- DO ED1(PRCA,PRCB)
- +20 QUIT
- +21 ;
- PCL ;set-up program dic (called from prc5a)
- +1 NEW PRCRI,PRCA,PRCB,PRCC,PRCSTRI
- +2 DO EN^DDIOL("POST INITIAL: Process FMS PCL-DOCUMENT"_" at "_$$NOW^PRC5A)
- +3 SET PRCSTRI=$ORDER(^PRCD(420.1999,"AC","A",""))
- +4 SET PRCRI(420.92)=0
- FOR
- SET PRCRI(420.92)=$ORDER(^PRCU(420.92,"B","PCL",PRCRI(420.92)))
- if 'PRCRI(420.92)
- QUIT
- SET PRCA=^PRCU(420.92,PRCRI(420.92),0)
- if $PIECE(PRCA,"^",4)]""&($PIECE(PRCA,"^",6)="")
- Begin DoDot:1
- +5 DO ED(PRCRI(420.92),1)
- +6 SET PRCRI(420.923)=0
- +7 FOR
- SET PRCRI(420.923)=$ORDER(^PRCU(420.92,PRCRI(420.92),1,PRCRI(420.923)))
- if 'PRCRI(420.923)
- QUIT
- if $PIECE(^(PRCRI(420.923),0),"^",2)=""
- DO PCLED(PRCRI(420.92),PRCRI(420.923))
- +8 DO ED(PRCRI(420.92),2)
- End DoDot:1
- +9 DO EN^DDIOL("POST INITIAL: Process FMS PCL-DOCUMENT done!"_" at "_$$NOW^PRC5A)
- +10 QUIT
- +11 ;
- PCLED(PRCA,PRCB) ;set-up program dic
- +1 NEW PRCRI,PRCPGM,PRCPGMD,A
- +2 SET A=^PRCU(420.92,PRCA,1,PRCB,1)
- SET PRCPGM=$PIECE(A,"~",3)
- SET PRCPGMD=$PIECE(A,"~",4)
- +3 if PRCPGM=""
- QUIT
- +4 SET PRCRI(420.13)=$ORDER(^PRCD(420.13,"B",PRCPGM,""))
- +5 IF PRCRI(420.13)=""
- Begin DoDot:1
- +6 NEW X,Y
- +7 SET X=PRCPGM
- SET X("DR")="1////"_PRCPGMD_";2////"_PRCSTRI
- +8 DO ADD^PRC0B1(.X,.Y,"420.13;^PRCD(420.13,")
- +9 if Y>0
- SET PRCRI(420.13)=+Y
- +10 QUIT
- End DoDot:1
- if 'PRCRI(420.13)
- QUIT
- +11 ;edit convert field
- DO ED1(PRCA,PRCB)
- +12 QUIT
- +13 ;
- PAC ;set-up fcp/prj dic (called by prc5a)
- +1 GOTO PAC^PRC5B3
- +2 QUIT
- +3 ;
- CPF ;fill-in fms fields in file 420 (fcp file) (called from prc5a)
- +1 GOTO CPF^PRC5B2
- +2 ;
- +3 QUIT
- +4 ;
- ED(PRCA,PRCB) ;edit convert start/end time,PRCA=RI, PRCB=1 if start, 2 if end
- +1 SET PRCB=$SELECT(PRCB=1:2.6,1:2.7)
- +2 DO EDIT^PRC0B(.X,"420.92;;"_PRCA,PRCB_"///^S X=""N""")
- +3 QUIT
- +4 ;
- ED1(PRCA,PRCB) ;edit converted y/n
- +1 NEW A
- +2 SET A="420.92;^PRCU(420.92,;"_PRCA
- +3 SET A=A_"~"_"420.923;^PRCU(420.92,"_PRCA_",1,;"_PRCB
- +4 DO EDIT^PRC0B(.X,A,"2////Y")
- +5 QUIT
- +6 ;