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

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

initial load of WorldVistAEHR

File size: 4.4 KB
RevLine 
[613]1PXBGSTP2 ;ISL/JVS - DOUBLE ?? GATHERING OF STOP CODES ;1/24/97 14:14
2 ;;1.0;PCE PATIENT CARE ENCOUNTER;**11,19**;Aug 12, 1996
3 ;
4 ;
5 ;
6 W !,"NOT" Q
7 ;
8DOUBLE(FROM) ;--Entry point
9 ;
10 N FILE,FIELD,TITLE,HEADING,SUB,CODE,NAME,START,SCREEN,BACK,NUM
11 N SCREEN,TEMP,NRD,SUB2
12 S BACK="",NUM=0,SCREEN=""
13 D LOC
14 I $D(DIC("S")) S SCREEN=DIC("S")
15 ;
16START ;--RECYCLE
17 ;
18 S TITLE="- - A L L S T O P C O D E S - -"
19 ;
20 D SETUP
21 D LIST^DIC(FILE,"",FIELD,BACK,10,.START,"","C",SCREEN,"","^TMP(""PXBTANA"",$J)","^TMP(""PXBTANA"",$J)")
22 ;
23 D LOC,HEAD,SUB
24 ;
25PROMPT ;--PROMPT
26 D WIN17^PXBCC(PXBCNT),LOC^PXBCC(15,1)
27 W !!,"Enter '^' to quit, '-' for previous page."
28 S DIR("A")="Select a single 'ITEM NUMBER' or 'RETURN' to continue: "
29 S DIR("?")="Enter ITEM 'No' to select , '^' to quit, '-' for previous page."
30 S DIR(0)="N,A,O^0:10:0^I X'?.1""-"".1""^"".2N!(+X>10) K X"
31 D ^DIR
32 I X="-" S BACK="B" D BACK G START
33 I X="" S BACK="" D FORWARD G START
34 I $G(DIRUT) K DIRUT S VAL="^S" G EXIT
35FINISH ;--FINISH
36 ;
37 S VAL=$G(^TMP("PXBTANA",$J,"DILIST",2,X))_"^"_$G(^TMP("PXBTANA",$J,"DILIST","ID",X,FIRST))_"--"_$G(^TMP("PXBTANA",$J,"DILIST","ID",X,SECOND))
38EXIT ;--EXIT
39 K DIR,^TMP("PXBTANA",$J),^TMP("PXBTOTAL",$J)
40 Q VAL
41 ;
42DOUBLE1(FROM) ;--Entry point
43 ;
44 N FILE,FIELD,TITLE,HEADING,SUB,CODE,NAME,START,SCREEN,CNT,OK,INDEX,CYCLE
45 N TOTAL,TEMP,SUB2
46 ;---SETUP VARIABLES
47 S BACK="",INDEX=""
48 S START=DATA,SUB=0,SUB2=0
49 ;
50START1 ;--RECYCLE POINT
51 S TITLE="- - S E L E C T E D S T O P C O D E S - -"
52 S FILE=40.7
53 S FIELD="1;.01"
54 I DATA?1N S START=DATA*100,INDEX="C"
55 I DATA?2N S START=DATA*10,INDEX="C"
56 I DATA?3N S START=(DATA-(1)),INDEX="C"
57 I DATA?2.A S START=$O(^DIC(40.7,"B",DATA),-1)
58 I DATA?1A S DATA="*"
59 ;
60 D LIST^DIC(FILE,"",FIELD,BACK,"",.START,DATA,INDEX,DIC("S"),"","^TMP(""PXBTOTAL"",$J)","^TMP(""PXBTOTAL"",$J)")
61 ;
62 S TOTAL=$P(^TMP("PXBTOTAL",$J,"DILIST",0),"^",1)
63 ;
64 ;--DISPLAY IF NO MATCH FOUND
65 I TOTAL=0 D
66 .I DATA="*" W ! D HELP^PXBUTL0("CPT4")
67 .I DATA'="*" W ! D HELP^PXBUTL0("CPTM")
68 .S ERROR=1,CYCL=1
69 I TOTAL=0 Q TOTAL
70 ;
71 ;
72 ;----DISPLAY LIST TO THE SCREEN
73 S HEADING="W !,""ITEM"",?6,""CODE"",?15,""DESCRIPTION "",IOINHI,TOTAL,"" MATCHES"",IOINLOW"
74LIST ;-DISPLAY LIST TO THE SCREEN
75 I TOTAL=1 S X=1 G VAL
76 D LOC W !
77 X HEADING
78 S SUB=SUB-1
79 S NUM=0 F S SUB=$O(^TMP("PXBTOTAL",$J,"DILIST","ID",SUB)) S NUM=NUM+1 Q:NUM=11 Q:SUB'>0 S SUB2=SUB2+1 D
80 .S CODE=$G(^TMP("PXBTOTAL",$J,"DILIST","ID",SUB,1))
81 .S NAME=$G(^TMP("PXBTOTAL",$J,"DILIST","ID",SUB,.01))
82 .W !,SUB,?6,CODE,?15,NAME
83 ;
84 ;----If There is only one selection go to proper prompting
85 I TOTAL=1 G PRMPT2
86 ;
87PRMPT ;---WRITE PROMPT HERE
88 D WIN17^PXBCC(PXBCNT)
89 D LOC^PXBCC(15,1)
90 W !
91 I SUB>0 W !,"Enter '^' to quit"
92 E I TOTAL>10 W !," END OF LIST"
93 I SUB>0 S DIR("A")="Select a single 'ITEM NUMBER' or 'RETURN' to continue: "
94 E S DIR("A")="Select a single 'ITEM NUMBER' or 'RETURN' to exit: "
95 S DIR("?")="Enter ITEM 'No' to select , '^' to quit"
96 S DIR(0)="N,A,O^0:"_SUB2_":0^I X'?.1""^"".N K X"
97 D ^DIR
98 I X="",SUB>0 G LIST
99 I X="",SUB'>0 S X="^"
100VAL ;-----Set the VAL equal to the value
101 S VAL=$G(^TMP("PXBTOTAL",$J,"DILIST",2,X))_"^"_$G(^TMP("PXBTOTAL",$J,"DILIST","ID",X,1))_"--"_$G(^TMP("PXBTOTAL",$J,"DILIST","ID",X,.01))
102EXITNEW ;--EXIT
103 K DIR,^TMP("PXBTANA",$J),^TMP("PXBTOTAL",$J)
104 K TANA,TOTAL
105 Q VAL
106 Q
107 ;
108 ;-----------------SUBROUTINES--------------
109BACK ;
110 S START=$G(^TMP("PXBTANA",$J,"DILIST",1,1))
111 S START("IEN")=$G(^TMP("PXBTANA",$J,"DILIST",2,1))
112 Q
113FORWARD ;
114 S START=$G(^TMP("PXBTANA",$J,"DILIST",1,10))
115 S START("IEN")=$G(^TMP("PXBTANA",$J,"DILIST",2,10))
116 Q
117LOC ;--LOCATE CURSOR
118 D LOC^PXBCC(3,1) ;--LOCATE THE CURSOR
119 W IOEDEOP ;--CLEAR THE PAGE
120 Q
121HEAD ;--HEAD
122 W !,IOCUU,IOBON,"HELP SCREEN",IOSGR0,?(IOM-$L(TITLE))\2,IOINHI,TITLE,IOINLOW,IOELEOL
123 Q
124SUB ;--DISPLAY LIST TO THE SCREEN
125 I $P(^TMP("PXBTANA",$J,"DILIST",0),"^",1)=0 W !!," E N D O F L I S T" Q
126 X HEADING
127 S SUB=0,CNT=0 F S SUB=$O(^TMP("PXBTANA",$J,"DILIST","ID",SUB)) Q:SUB'>0 S CNT=CNT+1 D
128 .S CODE=$G(^TMP("PXBTANA",$J,"DILIST","ID",SUB,FIRST))
129 .S NAME=$G(^TMP("PXBTANA",$J,"DILIST","ID",SUB,SECOND))
130 .W !,SUB,?6,CODE,?15,NAME
131 Q
132SETUP ;-SETP VARIABLES
133 S FILE=40.7,FIRST=1,SECOND=.01 D
134 S FIELD=FIRST_";"_SECOND
135 S HEADING="W !,""ITEM"",?6,""CODE"",?15,""DESCRIPTION"""
136 Q
137PRMPT2 ;-----Yes and No prompt if onlyi choice
138 D WIN17^PXBCC(PXBCNT)
139 D LOC^PXBCC(15,1)
140 S DIR("A")="Is this the correct entry "
141 S DIR("B")="YES"
142 S DIR(0)="Y"
143 D ^DIR
144 I Y=0 S X="^"
145 I Y=1 S X=1
146 G VAL
Note: See TracBrowser for help on using the repository browser.