69 lines
2.9 KiB
Mathematica
69 lines
2.9 KiB
Mathematica
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
|
|
;
|