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

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

initial load of WorldVistAEHR

File size: 3.4 KB
RevLine 
[613]1PXBGPL2 ;ISL/JVS - DOUBLE ?? GATHERING OF PATIENT PROBLEM LIST;3/8/96 11:33 ;11/5/96 14:18
2 ;;1.0;PCE PATIENT CARE ENCOUNTER;**11**;Aug 12, 1996
3 ;
4 W !,"THIS IS NOT AN ENTRY POINT" Q
5 ;
6 ;
7DOUBLE1(FROM) ;--Entry point
8 ;
9NEW ;
10 ;
11 S PNAME=NAME
12 N FILE,FIELD,TITLE,HEADING,SUB,CODE,NAME,START,SCREEN,CNT,OK,INDEX,CYCLE
13 N TOTAL,POV,CNT,PXBPMT,SUB2
14 ;---SETUP VARIABLES
15 S BACK="",INDEX=""
16 S START=DATA,SUB=0,SUB2=0
17 ;
18START1 ;--RECYCLE POINT
19 S TITLE="PATIENT PROBLEM LIST"
20 ;
21 D PL^PXBGPL(PATIENT)
22 ;
23 I '$D(PXBPMT) S TOTAL=0
24 I $D(PXBPMT) D
25 .S (POV,CNT)="" F S POV=$O(PXBPMT("PL",POV)) Q:POV="" S CNT=CNT+1 D
26 ..S ^TMP("PXBTOTAL",$J,"DILIST","ID",CNT,.01)=POV
27 I $D(CNT) S TOTAL=CNT
28 ;
29 ;--DISPLAY IF NO MATCH FOUND
30 I TOTAL=0 W IOCUU,IOCUU,!,IOELEOL D
31 .D LOC W !
32 .W !!! D HELP^PXBUTL0("PLM")
33 .D HELP1^PXBUTL1("CON") R OK:DTIME
34 I TOTAL=0 Q TOTAL
35 ;
36 ;
37 ;----DISPLAY LIST TO THE SCREEN
38 S HEADING="W !,""ITEM"",?6,""NAME"",?14,""DESCRIPTION "",IOINHI,TOTAL,"" MATCHES"",IOINLOW"
39LIST ;-DISPLAY LIST TO THE SCREEN
40 D LOC,HEAD
41 X HEADING
42 S SUB=SUB-1
43 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
44 .S NAME=$G(^TMP("PXBTOTAL",$J,"DILIST","ID",SUB,.01))
45 .W !,SUB,?6,$P(NAME," ",1),?14,$E($P(NAME," ",2,$L(NAME," ")),1,64)
46 ;
47 ;----If There is only one selection go to proper prompting
48 I TOTAL=1 G PRMPT2
49 I $G(VALL)=1 G PRMPT3
50 ;
51PRMPT ;---WRITE PROMPT HERE
52 D LOC^PXBCC(15,1)
53 D WIN17^PXBCC(PXBCNT)
54 W !
55 I SUB>0 W !,"Enter '^' to quit"
56 E I TOTAL>10 W !," END OF LIST"
57 I SUB>0 S DIR("A")="Select a single 'ITEM NUMBER' or 'RETURN' to continue: "
58 E S DIR("A")="Select a single 'ITEM NUMBER' or 'RETURN' to exit: "
59 S DIR("?")="^D HELP^PXBUTL0(""PL11"")"
60 S DIR(0)="N,A,O^0:"_SUB2_":0^I X'?.1""^"".N K X"
61 D ^DIR
62 I X="",SUB>0 G LIST
63 I X="",SUB'>0 S X="^"
64VAL ;-----Set the VAL equal to the value
65 S VAL=$G(^TMP("PXBTOTAL",$J,"DILIST",2,X))_"^"_$G(^TMP("PXBTOTAL",$J,"DILIST","ID",X,.01))
66EXITNEW ;--EXIT
67 K DIR,^TMP("PXBTANA",$J),^TMP("PXBTOTAL",$J)
68 K TANA,TOTAL
69 Q VAL
70PRMPT3 ;---WRITE PROMPT HERE
71 D LOC^PXBCC(15,1)
72 D WIN17^PXBCC(PXBCNT)
73 W !!
74 D HELP1^PXBUTL1("CON") R OK:DTIME
75 I SUB>0 G LIST
76 I SUB'>0 S X="^"
77VALL ;-----Set the VAL equal to the value
78 S VAL=$G(^TMP("PXBTOTAL",$J,"DILIST",2,X))_"^"_$G(^TMP("PXBTOTAL",$J,"DILIST","ID",X,.01))
79EXITNEWW ;--EXIT
80 K ^TMP("PXBTANA",$J),^TMP("PXBTOTAL",$J)
81 K TANA,TOTAL
82 Q VAL
83 Q
84 ;
85 ;-----------------SUBROUTINES--------------
86BACK ;
87 S START=$G(^TMP("PXBTANA",$J,"DILIST",1,1))
88 S START("IEN")=$G(^TMP("PXBTANA",$J,"DILIST",2,1))
89 Q
90FORWARD ;
91 S START=$G(^TMP("PXBTANA",$J,"DILIST",1,10))
92 S START("IEN")=$G(^TMP("PXBTANA",$J,"DILIST",2,10))
93 Q
94LOC ;--LOCATE CURSOR
95 D LOC^PXBCC(3,1) ;--LOCATE THE CURSOR
96 W IOEDEOP ;--CLEAR THE PAGE
97 Q
98HEAD ;--HEAD
99 W IOINHI,!,IOCUU,?(IOM-$L(TITLE))\2,TITLE,IOINLOW,IOELEOL
100 Q
101SUB ;--DISPLAY LIST TO THE SCREEN
102 I $P(^TMP("PXBTANA",$J,"DILIST",0),"^",1)=0 W !!," E N D O F L I S T" Q
103 X HEADING
104 S SUB=0,CNT=0 F S SUB=$O(^TMP("PXBTANA",$J,"DILIST","ID",SUB)) Q:SUB'>0 S CNT=CNT+1 D
105 .S NAME=$G(^TMP("PXBTANA",$J,"DILIST","ID",SUB,.01))
106 .W !,SUB,?6,NAME
107 Q
108SETUP ;-SETP VARIABLES
109 S FILE=200,FIELD=.01 D
110 S HEADING="W !,""ITEM"",?6,""NAME"""
111 Q
112PRMPT2 ;-----Yes and No prompt if onlyi choice
113 D WIN17^PXBCC(PXBCNT)
114 D LOC^PXBCC(15,1)
115 S DIR("A")="Is this the correct entry "
116 S DIR("B")="YES"
117 S DIR(0)="Y"
118 D ^DIR
119 I Y=0 S X="^"
120 I Y=1 S X=1
121 G VAL
Note: See TracBrowser for help on using the repository browser.