source: WorldVistAEHR/trunk/r/PCE_PATIENT_CARE_ENCOUNTER-AUTN-EFDP-PX-VSIT--PXRM/PXBPVST.m@ 770

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

initial load of WorldVistAEHR
File size: 6.2 KB
Line 
1PXBPVST ;ISL/JVS - PROMPT FOR VISITS (ENCOUNTERS) ;11/7/96 08:56
2 ;;1.0;PCE PATIENT CARE ENCOUNTER;**11**;Aug 12, 1996
3 ;
4 Q
5VST ;--PROMPTS FOR VISITS
6 N X,Y,ADD,DATA,DOUG
7 D LOC^PXBCC(15,0),WIN17^PXBCC(PXBCNT)
8 W !,IOCUD,IOELALL,IOCUD,IOELALL,IOCUU,IOCUU
9 ;
10 I $G(PROMPT)="A" G PRADD
11 I $G(PROMPT)="D" G PRDEL
12 I $G(PROMPT)["AD"!($G(PROMPT)["DA") G BOTH
13 ;
14PRMPT ;
15 S DIR("A",1)="'RETURN' to continue or '-' for previous screen"
16 I $G(PXBCNT)'>0 S DIR("A",1)=""
17 ;
18 ;
19 S DIR("?")="Enter item number or '-' to backup a screen or RETURN for next screen or '^' to exit."
20 I $G(PXBCNT)'>0 S DIR("?")="Enter 'RETURN' or '^' to exit this screen."
21 ;
22 ;
23 S DIR("A")="Select Encounter by entering the ITEM No. : "
24 I $G(PXBCNT)'>0 S DIR("A")="'RETURN' or '^' to exit: "
25 S DIR(0)="FAO^1:3"
26 D ^DIR K DIR
27 G VERIFY
28 ;
29PRADD ;
30 S DIR("A",1)="'RETURN' to continue or '-' for previous screen"
31 I $G(PXBCNT)'>0 S DIR("A",1)=""
32 ;
33 ;
34 S DIR("?")="Enter item number or A to add a new encounter or '-' to backup a screen or RETURN for next screen or '^' to exit."
35 I $G(PXBCNT)'>0 S DIR("?")="Enter A to add a new encounter, 'RETURN' or '^' to exit this screen."
36 ;
37 ;
38 S DIR("A")="Select ITEM No. or 'A' to ADD an Encounter: "
39 I $G(PXBCNT)'>0 S DIR("A")="Select 'A' to ADD or 'RETURN' to exit: "
40 S DIR(0)="FAO^1:3"
41 D ^DIR K DIR
42 G VERIFY
43 ;
44PRDEL ;
45 S DIR("A",1)="'RETURN' to continue or '-' for previous screen"
46 I $G(PXBCNT)'>0 S DIR("A",1)=""
47 ;
48 ;
49 S DIR("?")="Enter item number or '@' folowed by the 'ITEM No.'(eg @9) to delete an encounter or '-' to backup a screen or 'RETURN' for next screen or '^' to exit."
50 I $G(PXBCNT)'>0 S DIR("?")="Enter 'RETURN' or '^' to exit this screen."
51 ;
52 ;
53 S DIR("A")="Select ITEM No. or '@ITEM No.' to DELETE an Encounter: "
54 I $G(PXBCNT)'>0 S DIR("A")="Enter 'RETURN' or '^' to exit this screen: "
55 S DIR(0)="FAO^1:3"
56 D ^DIR K DIR
57 G VERIFY
58 ;
59BOTH ;
60 S DIR("A",1)="'RETURN' to continue or '-' for previous screen"
61 I $G(PXBCNT)'>0 S DIR("A",1)=""
62 ;
63 ;
64 S DIR("?")="Enter item number or A to add, or '@' followed by the 'ITEM No.'(eg @7) to DELETE a new encounter or '-' to backup a screen or 'RETURN' for next screen or '^' to exit."
65 I $G(PXBCNT)'>0 S DIR("?")="Enter item number or, A to add an encounter, 'RETURN' or '^' to exit this screen."
66 ;
67 ;
68 S DIR("A")="Select ITEM No. or 'A' to ADD or '@ITEM No.' to DELETE: "
69 I $G(PXBCNT)'>0 S DIR("A")="Select 'A' to ADD or 'RETURN' to exit: "
70 S DIR(0)="FAO^1:3"
71 D ^DIR K DIR
72 G VERIFY
73 ;
74 ;
75VERIFY ;--VERIFY INPUT
76 ;
77 ;
78 I $G(Y)?.N1"E".NAP S Y=" "_Y
79 I Y?24.N S Y=$E(Y,1,24)
80 S EDATA=$G(Y) D CASE^PXBUTL S (X,Y)=EDATA K EDATA
81 I $G(PROMPT)="A" G VERADD
82 I $G(PROMPT)="D" G VERDEL
83 I $G(PROMPT)["AD"!($G(PROMPT)["DA") G VERBOTH
84 ;
85VER ;
86 ;
87 I $G(PXBCNT)>0 S DOUG="-^" I DOUG'[Y&(Y'?1.3N) W IOELEOL,! D HELP1^PXBUTL1("VST2") G VST
88 I $G(PXBCNT)'>0 S DOUG="^" I DOUG'[Y W ! D HELP1^PXBUTL1("VST2") G VST
89 ;
90 ;
91 I Y?1.3N,Y>$G(PXBHIGH) W ! D HELP1^PXBUTL1("VST1") G VST
92 I Y=0!(Y="00")!(Y="000") W ! D HELP1^PXBUTL1("VST3") G VST
93 I Y#1!(Y<0) W ! D HELP1^PXBUTL1("VST4") G VST
94 I Y?1.3N,Y'>$G(^TMP("PXBDVST",$J,"START")) G CONFIRM
95 I Y?1.3N,Y'<($G(^TMP("PXBDVST",$J,"START"))+10) G CONFIRM
96 I Y="",($G(^TMP("PXBDVST",$J,"START"))+10)'<$G(PXBCNT) S VAL=-1 Q
97 I Y="" D DVST4^PXBDVST("+") G VST
98 I Y="-" D DVST4^PXBDVST("-") G VST
99 I $D(DIRUT) S VAL=-1
100 I Y?1.3N,Y'>PXBCNT S VAL=$O(^TMP("PXBSKY",$J,Y,0))
101 G EXIT
102VERADD ;
103 ;
104 I $G(PXBCNT)>0 S DOUG="-^A" I DOUG'[Y&(Y'?1.3N) W ! D HELP1^PXBUTL1("VST2") G VST
105 I $G(PXBCNT)'>0 S DOUG="^A" I DOUG'[Y W ! D HELP1^PXBUTL1("VST2") G VST
106 ;
107 ;
108 I Y?1.3N,Y>$G(PXBHIGH) W ! D HELP1^PXBUTL1("VST1") G VST
109 I Y=0!(Y="00")!(Y="000") W ! D HELP1^PXBUTL1("VST3") G VST
110 I Y#1!(Y<0) W ! D HELP1^PXBUTL1("VST4") G VST
111 I Y?1.3N,Y'>$G(^TMP("PXBDVST",$J,"START")) G CONFIRM
112 I Y?1.3N,Y'<($G(^TMP("PXBDVST",$J,"START"))+10) G CONFIRM
113 I Y="",($G(^TMP("PXBDVST",$J,"START"))+10)'<$G(PXBCNT) S VAL=-1 Q
114 I Y="" D DVST4^PXBDVST("+") G VST
115 I Y="-" D DVST4^PXBDVST("-") G VST
116 I $D(DIRUT) S VAL=-1
117 I Y?.A S DATA=Y D CASE^PXBUTL S Y=DATA
118 S DOUG="ADD" I DOUG[Y S VAL="A"
119 I Y?1.3N,Y'>PXBCNT S VAL=$O(^TMP("PXBSKY",$J,Y,0))
120 G EXIT
121VERDEL ;
122 ;
123 I $G(PXBCNT)>0 S DOUG="-^" I DOUG'[Y&(Y'?1.3N)&($E(Y,1)'["@") W ! D HELP1^PXBUTL1("VST2") G VST
124 I $G(PXBCNT)'>0 S DOUG="^" I DOUG'[Y W ! D HELP1^PXBUTL1("VST2") G VST
125 ;
126 ;
127 I $E(Y,1)["@" S Y=$E(Y,2,4),DEL=1
128 I Y?1.3N,Y>$G(PXBHIGH) W ! D HELP1^PXBUTL1("VST1") G VST
129 I Y=0!(Y="00")!(Y="000") W ! D HELP1^PXBUTL1("VST3") G VST
130 I Y#1!(Y<0) W ! D HELP1^PXBUTL1("VST4") G VST
131 I Y?1.3N,Y'>$G(^TMP("PXBDVST",$J,"START")) G CONFIRM
132 I Y?1.3N,Y'<($G(^TMP("PXBDVST",$J,"START"))+10) G CONFIRM
133 I Y="",($G(^TMP("PXBDVST",$J,"START"))+10)'<$G(PXBCNT) S VAL=-1 Q
134 I Y="" D DVST4^PXBDVST("+") G VST
135 I Y="-" D DVST4^PXBDVST("-") G VST
136 I $D(DIRUT) S VAL=-1
137 I Y?.A S DATA=Y D CASE^PXBUTL S Y=DATA
138 I $G(DEL) S VAL="D^"_$O(^TMP("PXBSKY",$J,Y,0))
139 I Y?1.3N,Y'>PXBCNT,'$G(DEL) S VAL=$O(^TMP("PXBSKY",$J,Y,0))
140 G EXIT
141VERBOTH ;
142 ;
143 I $G(PXBCNT)>0 S DOUG="-^A" I DOUG'[Y&(Y'?1.3N)&($E(Y,1)'["@") W ! D HELP1^PXBUTL1("VST2") G VST
144 I $G(PXBCNT)'>0 S DOUG="^A" I DOUG'[Y W ! D HELP1^PXBUTL1("VST2") G VST
145 ;
146 ;
147 I $E(Y,1)["@" S Y=$E(Y,2,4),DEL=1
148 I Y?1.3N,Y>$G(PXBHIGH) W ! D HELP1^PXBUTL1("VST1") G VST
149 I Y=0!(Y="00")!(Y="000") W ! D HELP1^PXBUTL1("VST3") G VST
150 I Y#1!(Y<0) W ! D HELP1^PXBUTL1("VST4") G VST
151 I Y?1.3N,Y'>$G(^TMP("PXBDVST",$J,"START")) G CONFIRM
152 I Y?1.3N,Y'<($G(^TMP("PXBDVST",$J,"START"))+10) G CONFIRM
153 I Y="",($G(^TMP("PXBDVST",$J,"START"))+10)'<$G(PXBCNT) S VAL=-1 Q
154 I Y="" D DVST4^PXBDVST("+") G VST
155 I Y="-" D DVST4^PXBDVST("-") G VST
156 I $D(DIRUT) S VAL=-1
157 I Y?.A S DATA=Y D CASE^PXBUTL S Y=DATA
158 S DOUG="A" I DOUG[Y S VAL="A"
159 I $G(DEL) S VAL="D^"_$O(^TMP("PXBSKY",$J,Y,0))
160 I Y?1.3N,Y'>PXBCNT,'$G(DEL) S VAL=$O(^TMP("PXBSKY",$J,Y,0))
161 G EXIT
162CONFIRM ;---CONFIRM A REQUEST NOT ON THE SCREEN
163 D DVST4^PXBDVST(Y)
164 N PXBLINE,PXBCOLM,PXBENT,ENTRY,YY
165 S YY=Y
166 S PXBLINE=(Y#10)+3 I Y#10=0,Y\10>0 S PXBLINE=(PXBLINE)+(10)
167 S PXBCOLM=4
168 S PXBENT=$G(^TMP("PXBSAM",$J,Y))
169 S ENTRY=$P(PXBENT,"^",1)
170 D RREVST^PXBCC(PXBLINE,PXBCOLM,ENTRY)
171 ;
172 S DIR(0)="YA"
173 S DIR("B")="YES"
174 S DIR("A")="Is this the entry you selected? "
175 D ^DIR K DIR
176 I Y=1,'$G(DEL) S VAL=$O(^TMP("PXBSKY",$J,YY,0)) G EXIT
177 I Y=1,$G(DEL) S VAL="D^"_$O(^TMP("PXBSKY",$J,YY,0)) G EXIT
178 I Y=0 G VST
179 G EXIT
180 ;
181EXIT ;
182 ;
183 ;
184 Q
Note: See TracBrowser for help on using the repository browser.