source: FOIAVistA/tag/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/OREV2.m@ 636

Last change on this file since 636 was 628, checked in by George Lilly, 14 years ago

initial load of FOIAVistA 6/30/08 version
File size: 8.9 KB
Line 
1OREV2 ;SLC/DAN Event delayed orders set up ;10/22/03 09:06
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**142,141,208**;Dec 17, 1997
3 ;DBIA reference section
4 ;10060- ^VA(200
5 ;2336 - XPAREDIT
6 ;10026- DIR
7 ;10116- VALM1
8 ;2052 - DID
9 ;10015- DIQ
10 ;10117- VALM10
11 ;10103- XLFDT
12 ;10104- XLFSTR
13DET ;Detailed display
14 N DIC,Y,ORJ,ORTMP,DA,CNT
15 S CNT=1,VALMBCK="R" K ^UTILITY("DIQ1",$J),^TMP("ORCXPND",$J),^TMP("VALM VIDEO",$J)
16 I $G(ORNMBR)="" S ORNMBR=$$ORDERS^OREV1("display")
17 F ORJ=1:1:$L(ORNMBR,",")-1 S ORTMP=$P(ORNMBR,",",ORJ),DA=$O(^TMP("OREDO",$J,"IDX",ORTMP,0)) D
18 .I ORJ'=1 S ^TMP("ORCXPND",$J,CNT,0)=$$REPEAT^XLFSTR("*",79),CNT=CNT+1 S ^TMP("ORCXPND",$J,CNT,0)=" ",CNT=CNT+1
19 .D SETG(DA)
20 S VALMCNT=CNT-1 S:VALMCNT=0 VALMBCK="Q" S:ORNMBR="^" VALMQUIT="Q"
21 Q
22 ;
23SETG(IEN) ;Set details into global
24 N DIC,DA,ORI,DR,GLOB,NAME,I,HASPRNT,ETYPE,PIECE
25 K ^UTILITY("DIQ1",$J)
26 S (DIC,GLOB)=$S(ORTYPE="E":100.5,1:100.6)
27 S DA=IEN
28 I '$D(@("^ORD("_GLOB_","_DA_",0)")) Q
29 I ORTYPE="E" D
30 .S HASPRNT=+$P($G(^ORD(100.5,IEN,0)),U,12)
31 .S ETYPE=$P(^ORD(100.5,$S(HASPRNT:HASPRNT,1:IEN),0),U,2)
32 .I HASPRNT D Q
33 ..S ^TMP("ORCXPND",$J,CNT,0)="This is a CHILD entry. (p) indicates value is from its parent entry.",CNT=CNT+1,^TMP("ORCXPND",$J,CNT,0)="",CNT=CNT+1
34 ..S DR=".01;.1;1;5;8;9;13;14"
35 ..D EN^DIQ1
36 ..S DA=HASPRNT ;Get parent information to display with child
37 ..S DR="2;3;4;6"_$S("^A^D^T^"[("^"_ETYPE_"^"):";7",1:"")
38 ..D EN^DIQ1
39 ..S PIECE="" F I=1:1:$L(DR,";") S PIECE=$P(DR,";",I) S ^UTILITY("DIQ1",$J,GLOB,IEN,PIECE)=^UTILITY("DIQ1",$J,GLOB,DA,PIECE)
40 ..S DA=IEN ;Reset DA to child IEN
41 .;
42 .S DR=".01:6"_$S("^A^T^D^"[("^"_ETYPE_"^"):";7:9",1:";8:9")_";13"
43 .D EN^DIQ1
44 I ORTYPE="A" D
45 .S ETYPE=$P(^ORD(100.6,DA,0),U,2)
46 .S DR=".01:"_$S("^D^T^"[("^"_$P(^ORD(100.6,IEN,0),U,2)_"^")&($$ASKOBS^OREV1):"6",1:"5")
47 .D EN^DIQ1
48 S ORI=0 F S ORI=$O(^UTILITY("DIQ1",$J,GLOB,DA,ORI)) Q:ORI="" D
49 .S NAME=$$GET1^DID(GLOB,ORI,,"LABEL")
50 .I NAME="DIVISION" S NAME=$S(ETYPE="A":"ADMIT TO",ETYPE="D":"DISCHARGE FROM",ETYPE="T":"TRANS TO/WITHIN",ETYPE="O":"SURGERY WITHIN",ETYPE="S":"TR SP CHANGE WITHIN",1:"MAN. REL. WITHIN")_" "_NAME
51 .S:$G(HASPRNT)&("^2^3^4^6^7^"[("^"_ORI_"^")) NAME=NAME_" (P)"
52 .S NAME=NAME_":"
53 .S ^TMP("ORCXPND",$J,CNT,0)=$$LJ^XLFSTR($E(NAME)_$$LOW^XLFSTR($E(NAME,2,$L(NAME))),30)_$G(^UTILITY("DIQ1",$J,GLOB,IEN,ORI)),CNT=CNT+1
54 I ORTYPE="E",$D(^ORD(100.5,"DAD",DA)) D GETCHILD ;If parent then show children
55 D GETMULT($S($G(HASPRNT):HASPRNT,1:IEN))
56 I $G(^TMP("ORHIST",$J,DUZ)) D GETHIST(ORTYPE),GETAHIST(ORTYPE)
57 K ^UTILITY("DIQ1",$J)
58 Q
59 ;
60GETMULT(IEN) ;Retrieve values from multiples
61 N ORK,I,J,DCNT,DEF,GLOB,LOC0,ORI,SUB
62 ;Multiples for release event file
63 I ORTYPE="E" D Q
64 .F ORK="LOC","TS" D
65 ..S GLOB=$S(ORK="LOC":"^DIC(42,",1:"^DIC(45.7,")
66 ..I $O(^ORD(100.5,IEN,ORK,0))>0 D
67 ...S ^TMP("ORCXPND",$J,CNT,0)=" ",CNT=CNT+1
68 ...S ^TMP("ORCXPND",$J,CNT,0)=$S(ORK="LOC":"Included Locations",1:"Included Treating Specialties")_$S($G(HASPRNT):" (p)",1:"")_":"
69 ...D:$D(IOUON)&($D(IOUOFF)) CNTRL^VALM10(CNT,1,$L(^(0)),IOUON,IOUOFF)
70 ...S CNT=CNT+1
71 ...S ORI=0 F S ORI=$O(^ORD(100.5,IEN,ORK,ORI)) Q:'+ORI D
72 ....S DEF=$P(^ORD(100.5,IEN,ORK,ORI,0),"^",2) ;Is this the default?
73 ....S ^TMP("ORCXPND",$J,CNT,0)=$P($G(@(GLOB_+$P(^ORD(100.5,IEN,ORK,ORI,0),"^")_",0)")),"^")_$S(DEF:" (Default)",1:""),CNT=CNT+1
74 ;Multiples for auto-dc file
75 ;Get movements, divisions, packages, display groups, and orderable items
76 F SUB=3,6,7,10,8 D
77 .I $O(^ORD(100.6,IEN,SUB,0))>0 D
78 ..S ^TMP("ORCXPND",$J,CNT,0)=" ",CNT=CNT+1
79 ..S ^TMP("ORCXPND",$J,CNT,0)=$S(SUB=3:"Movement Types:",SUB=6:"From Divisions:",SUB=7:"Included Packages:",SUB=10:"Excluded Display Groups:",1:"Excluded Orderable Items:")
80 ..D:$D(IOUON)&($D(IOUOFF)) CNTRL^VALM10(CNT,1,$L(^(0)),IOUON,IOUOFF)
81 ..S CNT=CNT+1
82 ..S GLOB=$S(SUB=3:"^DG(405.2,",SUB=6:"^DIC(4,",SUB=7:"^DIC(9.4,",SUB=10:"^ORD(100.98,",1:"^ORD(101.43,")
83 ..S I=0 F S I=$O(^ORD(100.6,IEN,SUB,I)) Q:'+I D
84 ...S ^TMP("ORCXPND",$J,CNT,0)=$$GET1^DIQ(+$P(GLOB,"(",2),+$P(^ORD(100.6,IEN,SUB,I,0),U)_",",.01,"")
85 ...I SUB=8,$G(@(GLOB_+$P(^ORD(100.6,IEN,SUB,I,0),U)_",.1)")) S ^TMP("ORCXPND",$J,CNT,0)=^TMP("ORCXPND",$J,CNT,0)_" (* INACTIVE *)"
86 ...S CNT=CNT+1
87 ;
88 ;Get Treating Specialties
89 I $O(^ORD(100.6,IEN,4,0))>0 D
90 .S ^TMP("ORCXPND",$J,CNT,0)=" ",CNT=CNT+1
91 .S ^TMP("ORCXPND",$J,CNT,0)="Excluding From Treating Specialties: To Treating Specialties:"
92 .D:$D(IOUON)&($D(IOUOFF)) CNTRL^VALM10(CNT,1,$L(^(0)),IOUON,IOUOFF)
93 .S CNT=CNT+1
94 .S GLOB="^DIC(45.7,"
95 .S I=0 F S I=$O(^ORD(100.6,IEN,4,I)) Q:'+I D
96 ..S ^TMP("ORCXPND",$J,CNT,0)=$$LJ^XLFSTR($P($G(@(GLOB_+$P(^ORD(100.6,IEN,4,I,0),U)_",0)")),U),40)
97 ..S DCNT=0
98 ..S J=0 F S J=$O(^ORD(100.6,IEN,4,I,1,J)) Q:'+J D
99 ...S:DCNT'=0 CNT=CNT+1
100 ...S ^TMP("ORCXPND",$J,CNT,0)=$S(DCNT=0:^TMP("ORCXPND",$J,CNT,0),1:$$REPEAT^XLFSTR(" ",40))_$P($G(@(GLOB_+$P(^ORD(100.6,IEN,4,I,1,J,0),U)_",0)")),U)
101 ...S DCNT=1
102 ..S CNT=CNT+1
103 ;Locations
104 I $O(^ORD(100.6,IEN,5,0)) D
105 .S ^TMP("ORCXPND",$J,CNT,0)=" ",CNT=CNT+1
106 .S ^TMP("ORCXPND",$J,CNT,0)="Including From Locations:"_$$REPEAT^XLFSTR(" ",15)_"To Locations:"
107 .D:$D(IOUON)&($D(IOUOFF)) CNTRL^VALM10(CNT,1,$L(^(0)),IOUON,IOUOFF)
108 .S CNT=CNT+1
109 .S GLOB="^SC("
110 .S I=0 F S I=$O(^ORD(100.6,IEN,5,I)) Q:'+I D
111 ..S LOC0=^ORD(100.6,IEN,5,I,0)
112 ..S ^TMP("ORCXPND",$J,CNT,0)=$$LJ^XLFSTR($S($P(LOC0,U,2)=1:"* (All Locations)",1:$P($G(@(GLOB_+$P(LOC0,U,3)_",0)")),U)),40)
113 ..S ^TMP("ORCXPND",$J,CNT,0)=^TMP("ORCXPND",$J,CNT,0)_$S($P(LOC0,U,4)=1:"* (All Locations)",1:$P($G(@(GLOB_+$P(LOC0,U,5)_",0)")),U)),CNT=CNT+1
114 Q
115 ;
116GETHIST(TYPE) ;Print activation history on detailed report
117 N ORGLOB,I,VALUE
118 S ORGLOB="^ORD(100."_$S(ORTYPE="E":"5,",1:"6,")
119 I $D(@(ORGLOB_IEN_",2)")) S ^TMP("ORCXPND",$J,CNT,0)=" ",CNT=CNT+1,^TMP("ORCXPND",$J,CNT,0)="Activation History:" D
120 .D:$D(IOUON)&($D(IOUOFF)) CNTRL^VALM10(CNT,1,$L(^(0)),IOUON,IOUOFF)
121 .S CNT=CNT+1
122 S I=0 F S I=$O(@(ORGLOB_IEN_",2,"_I_")")) Q:'+I D
123 .S VALUE=$G(^(I,0)) Q:VALUE=""
124 .S ^TMP("ORCXPND",$J,CNT,0)="Activated: "_$$FMTE^XLFDT($P(VALUE,U),1)_" Inactivated: "_$$FMTE^XLFDT($P(VALUE,U,2),1),CNT=CNT+1
125 Q
126 ;
127GETAHIST(TYPE) ;Print audit history on detailed report
128 N ORGLOB,ORI,VALUE,DIC,DR,DA,DIQ,NAME
129 S ORGLOB="^ORD(100."_$S(ORTYPE="E":"5,",1:"6,")
130 I $D(@(ORGLOB_IEN_",9)")) S ^TMP("ORCXPND",$J,CNT,0)=" ",CNT=CNT+1,^TMP("ORCXPND",$J,CNT,0)="Add/Edit History:" D
131 .D:$D(IOUON)&($D(IOUOFF)) CNTRL^VALM10(CNT,1,$L(^(0)),IOUON,IOUOFF)
132 .S CNT=CNT+1
133 S ORI=0 F S ORI=$O(@(ORGLOB_IEN_",9,"_ORI_")")) Q:'+ORI D
134 .S VALUE=$G(^(ORI,0)) Q:VALUE=""
135 .K NAME S DIC=200,DR=".01",DA=+$P(VALUE,U,2),DIQ="NAME",DIQ(0)="E" D EN^DIQ1
136 .S ^TMP("ORCXPND",$J,CNT,0)=$S($P(VALUE,U,3)="N":"Added",1:"Edited")_" on "_$$FMTE^XLFDT($P(VALUE,U),1)_" by "_$G(NAME(200,DA,.01,"E")),CNT=CNT+1
137 Q
138 ;
139IWT(DA) ;Function to determine if MAS MOVEMENT Interward transfer is being used by itself. It may not be used in conjunction with other transfer types
140 N IWT
141 S IWT=0
142 I $P($G(^ORD(100.6,DA,0)),U,2)="T",$P($G(^ORD(100.6,DA,3,0)),U,4)=1,$D(^ORD(100.6,DA,3,"B",4)) S IWT=1
143 Q IWT
144 ;
145INCHIST ;Toggles audit and activation histories for inclusion on the detailed display
146 N INC,DIR,Y
147 S INC=$G(^TMP("ORHIST",$J,DUZ))
148 S VALMBCK="R" D FULL^VALM1
149 W !!,"Currently, the audit and activation histories are "_$S('INC:"not ",1:"")_"appearing",!,"on the detailed display.",!
150 S DIR(0)="Y",DIR("A")="Do you want to "_$S('INC:"include them on",1:"remove them from")_" the detailed display",DIR("B")="N" D ^DIR
151 I Y'=1 W !,"Nothing changed!" Q
152 W !,"Histories are now "_$S('INC:"included.",1:"removed.")
153 I 'INC S ^TMP("ORHIST",$J,DUZ)=1
154 I INC K ^TMP("ORHIST",$J,DUZ)
155 Q
156 ;
157FULLDSP ;Toggle between expanded and truncated display
158 N DSP,DIR,Y,DIRUT
159 S DSP=$G(^TMP("ORDSP",$J,DUZ))
160 W !!,"Currently, the display is "_$S('DSP:"truncated.",1:"expanded."),!
161 S DIR(0)="Y",DIR("A")="Do you want to "_$S(DSP:"truncate",1:"expand")_" this display",DIR("B")="N" D ^DIR K DIR
162 W:Y'=1 !,"Nothing changed!",! Q:$D(DIRUT)
163 W:Y=1 !,"List is now "_$S('DSP:"expanded.",1:"truncated."),!
164 I Y&('DSP) S ^TMP("ORDSP",$J,DUZ)=1
165 I Y&(DSP) K ^TMP("ORDSP",$J,DUZ)
166 S DIR(0)="Y",DIR("A")="Terminal emulator in 80 column mode",DIR("B")="Y"
167 S DIR("?")="Enter yes for 80 column or no for 132 column mode. Display will be updated to relfect your answer."
168 D ^DIR Q:$D(DIRUT)
169 S VALMWD=$S(Y=1:80,1:132)
170 Q
171 ;
172LIST ;Change which entries appear in list
173 N LST,Y,DIR,DIRUT
174 S LST=$G(^TMP("ORLIST",$J,DUZ))
175 W !!,"Currently, the list includes "_$S(LST="A":"only active",LST="I":"only inactive",1:"all")_" entries."
176 S DIR(0)="SO^1:Active entries only;2:Inactive entries only;3:All entries",DIR("A")="Select which entries should appear on the list"
177 D ^DIR
178 Q:+Y'>0
179 I Y=3 K ^TMP("ORLIST",$J,DUZ) Q
180 S ^TMP("ORLIST",$J,DUZ)=$E(Y(0))
181 I LST'=$G(^TMP("ORLIST",$J,DUZ)) S VALMBG=1
182 Q
183 ;
184CD ;Change display
185 S VALMBCK="R" D FULL^VALM1
186 D FULLDSP,LIST
187 Q
188 ;
189GETCHILD ;
190 N I
191 S ^TMP("ORCXPND",$J,CNT,0)="",CNT=CNT+1
192 S ^TMP("ORCXPND",$J,CNT,0)="Child events:"
193 D:$D(IOUON)&($D(IOUOFF)) CNTRL^VALM10(CNT,1,$L(^(0)),IOUON,IOUOFF)
194 S CNT=CNT+1
195 S I=0 F S I=$O(^ORD(100.5,"DAD",DA,I)) Q:'+I S ^TMP("ORCXPND",$J,CNT,0)=$P(^ORD(100.5,I,0),U),CNT=CNT+1
196 Q
Note: See TracBrowser for help on using the repository browser.