| [613] | 1 | PRC5B3 ;WISC/PLT-PRC5B continue ; 10/14/94 9:47 AM
|
|---|
| 2 | V ;;5.0;IFCAP;;4/21/95
|
|---|
| 3 | QUIT ;invalid entry
|
|---|
| 4 | ;
|
|---|
| 5 | PAC ;set-up fcp/prj dic (called by prc5b)
|
|---|
| 6 | N PRCRI,PRCA,PRCB,PRCC,PRCSTRI
|
|---|
| 7 | D EN^DDIOL("POST INITIAL: Process FMS PAC-DOCUMENT"_" at "_$$NOW^PRC5A)
|
|---|
| 8 | S PRCSTRI=$O(^PRCD(420.1999,"AC","A",""))
|
|---|
| 9 | 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)="")
|
|---|
| 10 | . D ED^PRC5B1(PRCRI(420.92),1)
|
|---|
| 11 | . S PRCRI(420.923)=0
|
|---|
| 12 | . 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))
|
|---|
| 13 | . D ED^PRC5B1(PRCRI(420.92),2)
|
|---|
| 14 | D EN^DDIOL("POST INITIAL: Process FMS PAC-DOCUMENT done!"_" at "_$$NOW^PRC5A)
|
|---|
| 15 | QUIT
|
|---|
| 16 | ;
|
|---|
| 17 | PACED(PRCA,PRCB) ;set-up fcp/prj dic (station related)
|
|---|
| 18 | N PRCRI,PRCSITE,PRCACC,PRCACCD,A
|
|---|
| 19 | S A=^PRCU(420.92,PRCA,1,PRCB,1),PRCSITE=$P(A,"~",3),PRCACC=$P(A,"~",4),PRCACCD=$P(A,"~",5)
|
|---|
| 20 | Q:PRCSITE=""!(PRCACC="")
|
|---|
| 21 | Q:'$D(^PRC(411,+PRCSITE))
|
|---|
| 22 | S PRCRI(420.131)=$O(^PRCD(420.131,"B",PRCACC,""))
|
|---|
| 23 | I PRCRI(420.131)="" D QUIT:PRCRI(420.131)<1
|
|---|
| 24 | . N X,Y
|
|---|
| 25 | . S X=PRCACC,X("DR")="1////"_PRCACCD_";2////"_PRCSTRI
|
|---|
| 26 | . D ADD^PRC0B1(.X,.Y,"420.131;^PRCD(420.131,")
|
|---|
| 27 | . S:Y PRCRI(420.131)=+Y
|
|---|
| 28 | . QUIT
|
|---|
| 29 | D ED1^PRC5B1(PRCA,PRCB) ;edit convert field
|
|---|
| 30 | QUIT
|
|---|
| 31 | ;
|
|---|
| 32 | ;
|
|---|
| 33 | CC ;deactivate the cost cent 6-digit codes without ending '00'
|
|---|
| 34 | N PRCRI,PRCA
|
|---|
| 35 | D EN^DDIOL("POST INITIAL: DEACTIVATE SUBCOSTCENT STARTS at "_$$NOW^PRC5A)
|
|---|
| 36 | 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
|
|---|
| 37 | . S PRCA=$P(A," ") QUIT:$E(PRCA,5,6)<1
|
|---|
| 38 | . D EDIT^PRC0B(.X,"420.1;;"_PRCRI(420.1),".5////1")
|
|---|
| 39 | . QUIT
|
|---|
| 40 | D EN^DDIOL("POST INITIAL: DEACTIVATE SUBCOSTCENT ENDS at "_$$NOW^PRC5A)
|
|---|
| 41 | QUIT
|
|---|
| 42 | ;
|
|---|
| 43 | SUB ;add entry to file 420.137 (called from prc5b)
|
|---|
| 44 | N PRCRI,PRCA,PRCB,PRCC,PRCSTRI
|
|---|
| 45 | D EN^DDIOL("POST INITIAL: Process FMS SUB-DOCUMENT at "_$$NOW^PRC5A)
|
|---|
| 46 | S PRCSTRI=$O(^PRCD(420.1999,"AC","A",""))
|
|---|
| 47 | 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)="")
|
|---|
| 48 | . D ED^PRC5B1(PRCRI(420.92),1)
|
|---|
| 49 | . S PRCRI(420.923)=0
|
|---|
| 50 | . 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))
|
|---|
| 51 | . D ED^PRC5B1(PRCRI(420.92),2)
|
|---|
| 52 | D EN^DDIOL("POST INITIAL: Process FMS SUB-DOCUMENT done!"_" at "_$$NOW^PRC5A)
|
|---|
| 53 | QUIT
|
|---|
| 54 | ;
|
|---|
| 55 | SUBED(PRCA,PRCB) ;set -up sub-obj dic
|
|---|
| 56 | N PRCRI,PRCSUB,PRCSUBD,A
|
|---|
| 57 | S A=^PRCU(420.92,PRCA,1,PRCB,1),PRCSUB=$P(A,"~",3)_$P(A,"~",4),PRCSUBD=$P(A,"~",5)
|
|---|
| 58 | QUIT:PRCSUB=""
|
|---|
| 59 | S PRCRI(420.137)=$O(^PRCD(420.137,"B",PRCSUB,""))
|
|---|
| 60 | I PRCRI(420.137)="" D QUIT:PRCRI(420.137)<1
|
|---|
| 61 | . N X,Y
|
|---|
| 62 | . S X=PRCSUB,X("DR")="1////"_PRCSUBD_";2////"_PRCSTRI
|
|---|
| 63 | . D ADD^PRC0B1(.X,.Y,"420.137;^PRCD(420.137,")
|
|---|
| 64 | . S:Y PRCRI(420.137)=+Y
|
|---|
| 65 | . QUIT
|
|---|
| 66 | D ED1^PRC5B1(PRCA,PRCB) ;edit convert field
|
|---|
| 67 | QUIT
|
|---|
| 68 | ;
|
|---|
