PRC5B3 ;WISC/PLT-PRC5B continue ; 10/14/94  9:47 AM
V ;;5.0;IFCAP;;4/21/95
 QUIT  ;invalid entry
 ;
PAC ;set-up fcp/prj dic (called by prc5b)
 N PRCRI,PRCA,PRCB,PRCC,PRCSTRI
 D EN^DDIOL("POST INITIAL: Process FMS PAC-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","PAC",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)="" PACED(PRCRI(420.92),PRCRI(420.923))
 . D ED^PRC5B1(PRCRI(420.92),2)
 D EN^DDIOL("POST INITIAL: Process FMS PAC-DOCUMENT done!"_" at "_$$NOW^PRC5A)
 QUIT
 ;
PACED(PRCA,PRCB) ;set-up fcp/prj dic (station related)
 N PRCRI,PRCSITE,PRCACC,PRCACCD,A
 S A=^PRCU(420.92,PRCA,1,PRCB,1),PRCSITE=$P(A,"~",3),PRCACC=$P(A,"~",4),PRCACCD=$P(A,"~",5)
 Q:PRCSITE=""!(PRCACC="")
 Q:'$D(^PRC(411,+PRCSITE))
 S PRCRI(420.131)=$O(^PRCD(420.131,"B",PRCACC,""))
 I PRCRI(420.131)="" D  QUIT:PRCRI(420.131)<1
 . N X,Y
 . S X=PRCACC,X("DR")="1////"_PRCACCD_";2////"_PRCSTRI
 . D ADD^PRC0B1(.X,.Y,"420.131;^PRCD(420.131,")
 . S:Y PRCRI(420.131)=+Y
 . QUIT
 D ED1^PRC5B1(PRCA,PRCB) ;edit convert field
 QUIT
 ;
 ;
CC ;deactivate the cost cent 6-digit codes without ending '00'
 N PRCRI,PRCA
 D EN^DDIOL("POST INITIAL: DEACTIVATE SUBCOSTCENT STARTS at "_$$NOW^PRC5A)
 S PRCRI(420.1)=0 F  S PRCRI(420.1)=$O(^PRCD(420.1,PRCRI(420.1))) Q:'PRCRI(420.1)  S A=^(PRCRI(420.1),0) D
 . S PRCA=$P(A," ") QUIT:$E(PRCA,5,6)<1
 . D EDIT^PRC0B(.X,"420.1;;"_PRCRI(420.1),".5////1")
 . QUIT
 D EN^DDIOL("POST INITIAL: DEACTIVATE SUBCOSTCENT ENDS at "_$$NOW^PRC5A)
 QUIT
 ;
SUB ;add entry to file 420.137 (called from prc5b)
 N PRCRI,PRCA,PRCB,PRCC,PRCSTRI
 D EN^DDIOL("POST INITIAL: Process FMS SUB-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","SUB",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)="" SUBED(PRCRI(420.92),PRCRI(420.923))
 . D ED^PRC5B1(PRCRI(420.92),2)
 D EN^DDIOL("POST INITIAL: Process FMS SUB-DOCUMENT done!"_" at "_$$NOW^PRC5A)
 QUIT
 ;
SUBED(PRCA,PRCB) ;set -up sub-obj dic
 N PRCRI,PRCSUB,PRCSUBD,A
 S A=^PRCU(420.92,PRCA,1,PRCB,1),PRCSUB=$P(A,"~",3)_$P(A,"~",4),PRCSUBD=$P(A,"~",5)
 QUIT:PRCSUB=""
 S PRCRI(420.137)=$O(^PRCD(420.137,"B",PRCSUB,""))
 I PRCRI(420.137)="" D  QUIT:PRCRI(420.137)<1
 . N X,Y
 . S X=PRCSUB,X("DR")="1////"_PRCSUBD_";2////"_PRCSTRI
 . D ADD^PRC0B1(.X,.Y,"420.137;^PRCD(420.137,")
 . S:Y PRCRI(420.137)=+Y
 . QUIT
 D ED1^PRC5B1(PRCA,PRCB) ;edit convert field
 QUIT
 ;