Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PRC5B1

PRC5B1.m

Go to the documentation of this file.
  1. PRC5B1 ;WISC/PLT-PRC5B continue ; 07/07/94 2:47 PM
  1. V ;;5.0;IFCAP;;4/21/95
  1. QUIT ;invalid entry
  1. ;
  1. ALD ;called by PRC5B
  1. N PRCA,PRCB,PRCC
  1. D EN^DDIOL("POST INITIAL: Move name (.01) to ald (5) for file 420.3"_" at "_$$NOW^PRC5A)
  1. S PRCA=0 F S PRCA=$O(^PRCD(420.3,PRCA)) Q:'PRCA S PRCB=^(PRCA,0) D:$P(PRCB,"^",7)=""&($P(PRCB,"^",6)="")
  1. . S PRCC=$P(PRCB,"^")
  1. . D EDIT^PRC0B(.X,"420.3;;"_PRCA,"5///^S X="""_PRCC_"""")
  1. . QUIT
  1. D EN^DDIOL("POST INITIAL: Move name (.01) to ald (5) for file 420.3 DONE"_" at "_$$NOW^PRC5A)
  1. QUIT
  1. ;
  1. FND ;add fund code to file 420.3
  1. N PRCRI,PRCA,PRCB,PRCC,PRCSTRI
  1. D EN^DDIOL("POST INITIAL: Process FMS FND-DOCUMENT"_" at "_$$NOW^PRC5A)
  1. S PRCSTRI=$O(^PRCD(420.1999,"AC","A",""))
  1. 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)="")
  1. . D ED(PRCRI(420.92),1)
  1. . S PRCRI(420.923)=0
  1. . 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))
  1. . D ED(PRCRI(420.92),2)
  1. D EN^DDIOL("POST INITIAL: Process FMS FND-DOCUMENT done!"_" at "_$$NOW^PRC5A)
  1. QUIT
  1. ;
  1. FNDED(PRCA,PRCB) ;start convert
  1. N PRCRI,PRCAPP,PRCFUND,PRCFUNDD,PRCYB,PRCYE,A
  1. S A=^PRCU(420.92,PRCA,1,PRCB,1),PRCAPP=$P(A,"~",2),PRCFUND=$P(A,"~",5)
  1. S PRCYB=+$$YEAR^PRC0C($P(A,"~",3)),PRCYE=+$$YEAR^PRC0C($S($P(A,"~",4):$P(A,"~",4),1:PRCYB)),PRCFUNDD=$P(A,"~",6)
  1. Q:PRCAPP=""!(PRCFUND="")!'PRCYB!'PRCYE
  1. ;add/edit fund file 420.14
  1. S PRCRI(420.14)=$O(^PRCD(420.14,"UNQ",PRCFUND,PRCYB,PRCYE,"")) D QUIT:'PRCRI(420.14)
  1. . I PRCRI(420.14) D EDIT^PRC0B(.X,"420.14;;"_PRCRI(420.14),"1///^S X="""_PRCFUNDD_"""") I 1
  1. . E S (PRCUQ,PRCK01,PRCK2,PRCK3)="" D
  1. .. S X=PRCFUND,X("DR")="1////"_PRCFUNDD_";2///^S X="""_PRCYB_""";3///^S X="""_PRCYE_""";5////"_PRCSTRI
  1. .. D ADD^PRC0B1(.X,.Y,"420.14;^PRCD(420.14,")
  1. .. S:Y>0 PRCRI(420.14)=+Y
  1. .. Q
  1. . Q
  1. 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)=""
  1. I 'PRCRI(420.3) D QUIT:'PRCRI(420.3)
  1. . S X=PRCFUND,X("DR")="2////"_PRCAPP_";4////"_$TR(PRCAPP,"_"," ")
  1. . D ADD^PRC0B1(.X,.Y,"420.3;^PRCD(420.3,")
  1. . S:Y>0 PRCRI(420.3)=+Y
  1. D ED1(PRCA,PRCB) ;edit convert field
  1. QUIT
  1. ;
  1. PCL ;set-up program dic (called from prc5a)
  1. N PRCRI,PRCA,PRCB,PRCC,PRCSTRI
  1. D EN^DDIOL("POST INITIAL: Process FMS PCL-DOCUMENT"_" at "_$$NOW^PRC5A)
  1. S PRCSTRI=$O(^PRCD(420.1999,"AC","A",""))
  1. 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)="")
  1. . D ED(PRCRI(420.92),1)
  1. . S PRCRI(420.923)=0
  1. . 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))
  1. . D ED(PRCRI(420.92),2)
  1. D EN^DDIOL("POST INITIAL: Process FMS PCL-DOCUMENT done!"_" at "_$$NOW^PRC5A)
  1. QUIT
  1. ;
  1. PCLED(PRCA,PRCB) ;set-up program dic
  1. N PRCRI,PRCPGM,PRCPGMD,A
  1. S A=^PRCU(420.92,PRCA,1,PRCB,1),PRCPGM=$P(A,"~",3),PRCPGMD=$P(A,"~",4)
  1. Q:PRCPGM=""
  1. S PRCRI(420.13)=$O(^PRCD(420.13,"B",PRCPGM,""))
  1. I PRCRI(420.13)="" D QUIT:'PRCRI(420.13)
  1. . N X,Y
  1. . S X=PRCPGM,X("DR")="1////"_PRCPGMD_";2////"_PRCSTRI
  1. . D ADD^PRC0B1(.X,.Y,"420.13;^PRCD(420.13,")
  1. . S:Y>0 PRCRI(420.13)=+Y
  1. . QUIT
  1. D ED1(PRCA,PRCB) ;edit convert field
  1. QUIT
  1. ;
  1. PAC ;set-up fcp/prj dic (called by prc5a)
  1. G PAC^PRC5B3
  1. QUIT
  1. ;
  1. CPF ;fill-in fms fields in file 420 (fcp file) (called from prc5a)
  1. G CPF^PRC5B2
  1. ;
  1. QUIT
  1. ;
  1. ED(PRCA,PRCB) ;edit convert start/end time,PRCA=RI, PRCB=1 if start, 2 if end
  1. S PRCB=$S(PRCB=1:2.6,1:2.7)
  1. D EDIT^PRC0B(.X,"420.92;;"_PRCA,PRCB_"///^S X=""N""")
  1. QUIT
  1. ;
  1. ED1(PRCA,PRCB) ;edit converted y/n
  1. N A
  1. S A="420.92;^PRCU(420.92,;"_PRCA
  1. S A=A_"~"_"420.923;^PRCU(420.92,"_PRCA_",1,;"_PRCB
  1. D EDIT^PRC0B(.X,A,"2////Y")
  1. QUIT
  1. ;