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

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

initial load of WorldVistAEHR

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