source: WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORY242.m@ 1747

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

initial load of WorldVistAEHR

File size: 3.8 KB
Line 
1ORY242 ;SLC/MKB -- Support for patch OR*3*242 ;11/21/05 11:16
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**242**;Dec 17, 1997;Build 6
3 ;
4PRE ; -- preinit
5 D NATURE
6 ;D REASON
7 Q
8 ;
9POST ; -- postinit
10 D VUID
11 Q
12 ;
13NATURE ; -- create new Nature of Order, verify standard values
14 N ORI,X,CODE,DA,X0,OR0,DR,DIE
15 ; enforce standard values
16 F ORI=1:1 S X=$T(ITEMS+ORI),CODE=$P(X,";",3) Q:CODE="ZZZZZ" D
17 . S DA=+$O(^ORD(100.02,"C",CODE,0)) Q:DA<1
18 . I +$G(^ORD(100.02,DA,1))'=+$P(X,";",5) S $P(^(1),U)=+$P(X,";",5)
19 . I $P(^ORD(100.02,DA,1),U,4)'=$P(X,";",6) S $P(^(1),U,4)=$P(X,";",6)
20 . S X0=$P(X,";",4),OR0=$G(^ORD(100.02,DA,0))
21 . I OR0'=X0 S DR="" D ;lock std values
22 .. F I=1:1:6 I $P(X0,U,I)'=$P(OR0,U,I) S DR=DR_".0"_I_"///"_$P(X0,U,I)_";"
23 .. I $L(DR) S DIE="^ORD(100.02," D ^DIE
24 ; add new SERVICE REJECT nature
25 S DA=+$O(^ORD(100.02,"B","SERVICE REJECT",0)) Q:DA ;done
26 S DA=+$O(^ORD(100.02,"B","PHARMACY REJECT",0)) I 'DA D ;use if exists,
27 . L +^ORD(100.02,0) ;else get new DA
28 . S DA=11 F S DA=DA+1 Q:'$D(^ORD(100.02,DA))
29 . S $P(^ORD(100.02,0),U,3,4)=DA_U_DA
30 . L -^ORD(100.02,0)
31 ; Kill old xrefs, if updating PHARMACY REJECT
32 S OR0=$G(^ORD(100.02,DA,0))
33 S X=$P(OR0,U) K:$L(X) ^ORD(100.02,"B",X,DA)
34 S X=$P(OR0,U,2) K:$L(X) ^ORD(100.02,"C",X,DA)
35 S X=$P(OR0,U,3) K:$L(X) ^ORD(100.02,"AC",X,DA)
36 ; Set new data
37 S ^ORD(100.02,DA,0)="SERVICE REJECT^R^0^^B^1",^(1)="1^1^0^2^^1"
38 S ^ORD(100.02,"AC",0,DA)=""
39 S ^ORD(100.02,"B","SERVICE REJECT",DA)=""
40 S ^ORD(100.02,"C","R",DA)=""
41 Q
42 ;
43ITEMS ;;CODE;0-node;CREATE ACTION;DEFAULT SIG STS
44 ;;W;WRITTEN^W^0^^X^0;1;0;
45 ;;V;VERBAL^V^0^^X^0;1;2;
46 ;;P;TELEPHONED^P^0^^X^0;1;2;
47 ;;S;SERVICE CORRECTION^S^0^^B^0;0;6;
48 ;;I;POLICY^I^0^^X^0;1;3;
49 ;;D;DUPLICATE^D^0^^X^1;0;;
50 ;;X;REJECTED^X^1^^B^1;0;;
51 ;;E;ELECTRONICALLY ENTERED^E^1^^F^0;1;2;
52 ;;A;AUTO^A^1^^X^0;0;;
53 ;;C;CHANGED^C^1^^X^1;0;;
54 ;;M;MAINTENANCE^M^1^^X^1;0;;
55 ;;R;SERVICE REJECT^R^0^^B^1;1;2;
56 ;;ZZZZZ;;;;
57 ;
58REASON ; -- restructure Reason file for standardization
59 ; [save for later use]
60 N ORI,X,CODE,DA,DR,DIE,DIK,LRI,LRX
61 ; update reason NAMEs
62 F ORI=1:1 S X=$T(NAMES+ORI),CODE=$P(X,";",3) Q:CODE="ZZZZZ" D
63 . S DA=+$O(^ORD(100.03,"C",CODE,0)) Q:DA<1
64 . Q:$P($G(^ORD(100.03,DA,0)),U)=$P(X,";",4) ;done
65 . S DR=".01///"_$P(X,";",4),DIE="^ORD(100.03," D ^DIE
66 ; move PACKAGE and CODE fields of #100.03 into multiple
67 S LRI=+$O(^ORD(100.03,"C","LRPCAN",0)),LRX=$G(^ORD(100.03,LRI,0))
68 S ORI=0 F S ORI=$O(^ORD(100.03,ORI)) Q:ORI<1 S X=$G(^(ORI,0)) D
69 . Q:$D(^ORD(100.03,ORI,1,0)) Q:'$P(X,U,5) ;done, or no data
70 . I ORI=LRI S $P(^ORD(100.03,ORI,0),U,4)=1 Q ;add to ORREQ instead
71 . S ^ORD(100.03,ORI,1,0)="^100.031P^1^1",^(1,0)=$P(X,U,5,6)
72 . S ^ORD(100.03,ORI,1,"B",+$P(X,U,5),1)=""
73 . S ^ORD(100.03,"APKG",+$P(X,U,5),ORI,1)=""
74 . S $P(^ORD(100.03,ORI,0),U,5,6)="^"
75 . I $L($P(X,U,6)) D ;reset C xref
76 .. K ^ORD(100.03,"C",$P(X,U,6),ORI)
77 .. S ^ORD(100.03,"C",$P(X,U,6),ORI,1)=""
78 . I $P(X,U,6)="ORREQ",$P(LRX,U,5) D ;add LRPCAN here
79 .. S ^ORD(100.03,ORI,1,0)="^100.031P^2^2",^(2,0)=$P(LRX,U,5,6)
80 .. S ^ORD(100.03,ORI,1,"B",+$P(LRX,U,5),2)=""
81 .. S ^ORD(100.03,"APKG",+$P(LRX,U,5),ORI,2)=""
82 .. S ^ORD(100.03,"C",$P(LRX,U,6),ORI,2)=""
83 .. K ^ORD(100.03,"C",$P(LRX,U,6),LRI)
84 .. S $P(^ORD(100.03,LRI,0),U,5,6)="^"
85 ; remove old PACKAGE and CODE fields, D xref
86 S DIK="^DD(100.03,",DA(1)=100.03 F DA=.05,.06 D ^DIK
87 K ^ORD(100.03,"D")
88 Q
89 ;
90NAMES ;;CODE;NAME of Reasons
91 ;;ORDUP;DUPLICATE ORDER
92 ;;ORDIS;DISCHARGE
93 ;;ORTRANS;TRANSFER
94 ;;ORSPEC;TREATING SPECIALTY CHANGE
95 ;;ORADMIT;ADMISSION
96 ;;ORREQ;PROVIDER CANCELLED
97 ;;OROBS;OBSOLETE ORDER
98 ;;ORERR;ENTERED IN ERROR
99 ;;ORDEATH;DEATH
100 ;;OROR;SURGERY
101 ;;ORPASS;PATIENT AWAY ON PASS
102 ;;ORASIH;ABSENT SICK IN HOSPITAL
103 ;;ZZZZZ;
104 ;
105VUID ; -- seed new VUID fields
106 N ORDOMPTR,TMP
107 S TMP=$$GETIEN^HDISVF09("ORDERS",.ORDOMPTR) ;IA#4651
108 I TMP D EN^HDISVCMR(ORDOMPTR,"") ;IA #4639
109 Q
Note: See TracBrowser for help on using the repository browser.