| [613] | 1 | ORY7 ;SLB/MKB-postinit for OR*3.0*7 ;3/20/98 14:45
|
|---|
| 2 | ;;3.0;ORDER ENTRY/RESULTS REPORTING;**7**;Dec 17, 1997
|
|---|
| 3 | ;
|
|---|
| 4 | POST ; -- Set ^ORD(100.03,"D"), value for Lab parameter
|
|---|
| 5 | ;
|
|---|
| 6 | N DIK,ORX
|
|---|
| 7 | I '$D(^ORD(100.03,"D")) S DIK="^ORD(100.03,",DIK(1)=".01^D" D ENALL^DIK
|
|---|
| 8 | S ORX=$P($G(^ORD(100.99,1,0)),U,18)
|
|---|
| 9 | D:$L(ORX) EN^XPAR("SYS","ORPF SHOW LAB #",1,ORX)
|
|---|
| 10 | Q
|
|---|
| 11 | ;
|
|---|
| 12 | PRE ; -- preinit cleanup of Order Reason file #100.03
|
|---|
| 13 | N DA,DIK,ORSYN,ORNM,ORI,ORACTV,ORINACT,ORX
|
|---|
| 14 | S DA=.001,DA(1)=100.03,DIK="^DD(100.03," D ^DIK ;remove NUMBER field
|
|---|
| 15 | F ORSYN="DUP","ER" D ;cleanup duplicates
|
|---|
| 16 | . K ORACTV,ORINACT S ORI=0
|
|---|
| 17 | . F S ORI=$O(^ORD(100.03,"S",ORSYN,ORI)) Q:ORI'>0 D
|
|---|
| 18 | .. S ORX=$G(^ORD(100.03,+ORI,0))
|
|---|
| 19 | .. I $P(ORX,U,4) S ORINACT=+$G(ORINACT)+1,ORINACT(+ORI)=ORX
|
|---|
| 20 | .. E S ORACTV=+$G(ORACTV)+1,ORACTV(+ORI)=ORX
|
|---|
| 21 | . S ORNM=$S(ORSYN="DUP":"Duplicate Order",1:"Entered in error")
|
|---|
| 22 | . I $G(ORINACT) S ORI=0 F S ORI=$O(ORINACT(ORI)) Q:ORI'>0 S ORX=ORINACT(ORI) D INACT
|
|---|
| 23 | . S ORI=$O(ORACTV(0)) Q:ORI'>0 S ORX=ORACTV(ORI)
|
|---|
| 24 | . I ORSYN="DUP",ORNM'=$P(ORX,U) D SETNM(ORI,ORNM)
|
|---|
| 25 | . I ORSYN="ER",'$P(ORX,U,7) S $P(^ORD(100.03,ORI,0),U,7)=+$O(^ORD(100.02,"C","M",0)) ;set nature="maintenance"
|
|---|
| 26 | . I $G(ORACTV)>1 F S ORI=$O(ORACTV(ORI)) Q:ORI'>0 S ORX=ORACTV(ORI) D INACT ;inactivate extra entries
|
|---|
| 27 | Q
|
|---|
| 28 | ;
|
|---|
| 29 | INACT ; -- inactivate reason
|
|---|
| 30 | N DA,DR,DIE,X,Y
|
|---|
| 31 | S DA=ORI,DIE="^ORD(100.03,",DR=".03///@;.04////1;.06///@"
|
|---|
| 32 | S:ORNM=$P(ORX,U) DR=".01///Z"_ORNM_";"_DR D ^DIE
|
|---|
| 33 | Q
|
|---|
| 34 | ;
|
|---|
| 35 | SETNM(DA,X) ; -- set .01 Name
|
|---|
| 36 | N DR,DIE,Y Q:'DA
|
|---|
| 37 | S DIE="^ORD(100.03,",DR=".01///"_X D ^DIE
|
|---|
| 38 | Q
|
|---|
