source: WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORY7.m

Last change on this file was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.5 KB
Line 
1ORY7 ;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 ;
4POST ; -- 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 ;
12PRE ; -- 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 ;
29INACT ; -- 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 ;
35SETNM(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
Note: See TracBrowser for help on using the repository browser.