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

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

initial load of WorldVistAEHR
File size: 4.9 KB
RevLine 
[613]1PXBDPOV ;ISL/JVS - DISPLAY POV (DIAGNOSIS) ;3/10/04 12:12pm
2 ;;1.0;PCE PATIENT CARE ENCOUNTER;**124**;Aug 12, 1996
3 ;
4 ;
5EN0 ;---Main entry point
6 I '$D(IOCUU) D TERM^PXBCC
7 ;
8HEAD ;--HEADER ON LIST
9 S HEAD="- - E N C O U N T E R D I A G N O S I S (ICD9 CODES) - -"
10 W !,IOCUU,?(IOM-$L(HEAD))\2,IOINHI,HEAD
11 W IOINLOW,IOELEOL K HEAD
12 ;
13 I $D(CLINIC) D POV^PXBUTL2(CLINIC)
14 ;I PXBCNT<11 D DPOV1
15 ;I PXBCNT>10&($D(PXBNPOV)) D DPOV4("SAME")
16 ;I PXBCNT>10&('$D(PXBNPOV)) D DPOV4("BEGIN")
17 D DPOV4($S($D(PXBNPOV):"SAME",1:"BEGIN"))
18 Q
19 ;
20 ;
21DPOV1 ;--Display the POV Data
22 N ENTRY,K
23 D UNDON^PXBCC
24 W !,"No.",?5,"ICD",?13,"DESCRIPTION",?64,"PROBLEM LIST"
25 W IOEDEOP
26 D UNDOFF^PXBCC
27 ;
28 ;
29 S (K,J)=0 F S J=$O(PXBSAM(J)) Q:J="" D
30 .S ENTRY=$G(PXBSAM(J)) I $D(PXBNPOV($P(ENTRY,"^",1))) S $P(ENTRY,"^",1)=$P(ENTRY,"^",1)_"*"
31 .I $P(ENTRY,U)=0 D CIA($P(ENTRY,U,2,16)) Q
32 .S K=K+1
33 .W !,K,?4,$J($P($P(ENTRY,"^",1),".",1),4),".",$P($P(ENTRY,"^",1),".",2),?13,$E($P(ENTRY,"^",3),1,30),?44 W:$P(ENTRY,"^",4)["PRI" $P(ENTRY,"^",4)
34 .I $P(ENTRY,"^",4)["PRI" W ?71,$P(ENTRY,"^",5)
35 .E W ?74,$P(ENTRY,"^",5)
36 .D DIS
37 ;---Write no entries if none exsist
38 I '$D(PXBSAM) D NONE^PXBUTL(3)
39 ;-------------UNCOMMENT TO LIST CLINIC POV TO SCREEN-----
40 ;D DEF^PXBDPOV("A")
41 ;----------------------------------------------------
42 D DEF^PXBDPOV("D") I '$D(FIRST) K PXBDPOV
43 Q
44 ;
45 ;
46 ;
47DPOV4(SIGN) ;--Display the PROVIDER Data
48 ;
49 ;SIGN=
50 ; '+' add 10 to the starting point in ^TMP("PXBDPOV",$J)
51 ; '-' subtract 10 from the starting point but not less that 0
52 ; 'BEGIN' start at the beginning
53 ; 'SAME' start stays where it's at
54 ; '3'--any number set start to that number
55 ;
56 N PXBSTART,PXTMP
57 I SIGN="BEGIN" S ^TMP("PXBDPOV",$J,"START")=0,PXBSTART=0
58 I SIGN="SAME" S PXBSTART=^TMP("PXBDPOV",$J,"START")
59 I SIGN="+" S PXBSTART=($G(^TMP("PXBDPOV",$J,"START"))+(10)) S:PXBSTART'<PXBCNT PXBSTART=(PXBCNT-(10)) S ^TMP("PXBDPOV",$J,"START")=PXBSTART
60 I SIGN="-" S PXBSTART=$G(^TMP("PXBDPOV",$J,"START"))-10,^TMP("PXBDPOV",$J,"START")=PXBSTART I PXBSTART<0 S PXBSTART=0 S ^TMP("PXBDPOV",$J,"START")=0
61 I +SIGN>0&(SIGN#10) S PXBSTART=$P((SIGN/10),".")*10 S:PXBSTART<10 PXBSTART=0 Q:^TMP("PXBDPOV",$J,"START")=PXBSTART S ^TMP("PXBDPOV",$J,"START")=PXBSTART
62 I +SIGN>0&'(SIGN#10) S PXBSTART=(($P((SIGN/10),".")*10)-10) S:PXBSTART<10 PXBSTART=0 Q:^TMP("PXBDPOV",$J,"START")=PXBSTART S ^TMP("PXBDPOV",$J,"START")=PXBSTART
63 ;
64 ;
65 I SIGN'="BEGIN" D LOC^PXBCC(3,0) W IOEDEOP
66 ;
67HEAD4 ;--HEADER ON LIST
68 S HEAD="- - E N C O U N T E R D I A G N O S I S (ICD9 CODES) - -"
69 W !,IOCUU,?(IOM-$L(HEAD))\2,IOINHI,HEAD ;----F W $C(32) Q:$X=(IOM-(1))
70 W IOINLOW,IOELEOL K HEAD
71 ;
72 N ENTRY,J,K
73 D UNDON^PXBCC
74 W !,"No.",?5,"ICD",?13,"DESCRIPTION",?64,"PROBLEM LIST"
75 W IOEDEOP
76 D UNDOFF^PXBCC
77 D ARRAY
78 ;
79 S J=PXBSTART,K=J
80 F S J=$O(@PXTMP@(J)) Q:J="" Q:K=(PXBSTART+11) D
81 .S ENTRY=$G(@PXTMP@(J,0)),K=K+1
82 .I $P(ENTRY,U)=0 D CIA($P(ENTRY,U,2,16)) Q
83 .S ENTRY=$P(ENTRY,U,2,15)
84 .I $D(PXBNCPT($P(ENTRY,"^",1))) S $P(ENTRY,"^",1)=$P(ENTRY,"^",1)_"*"
85 .W !,J+1\2,?4,$J($P($P(ENTRY,"^",1),".",1),4),".",$P($P(ENTRY,"^",1),".",2),?13,$E($P(ENTRY,"^",3),1,30),?44
86 .W:$P(ENTRY,"^",4)["PRI" IOINHI,$P(ENTRY,"^",4),IOINLOW
87 .W ?$P(ENTRY,"^",4)["PRI"*7+53,$P(ENTRY,"^",7)
88 .I $P(ENTRY,"^",4)["PRI" W ?71,$P(ENTRY,"^",5)
89 .D DIS
90 I SIGN'="BEGIN" W !!
91 ;------------UNCOMMENT TO LIST PORVIDERS TO SCREEN--------
92 ;D DEF^PXBDPOV("A")
93 ;---------------------------------------------------------
94 D DEF^PXBDPOV("D") I '$D(FIRST) K PXBDPOV
95 Q
96 ;
97 ;
98DEF(CODE) ;---PROCESS DEFAULT LIST OF DIAGNOSIS
99 ; I CODE="D" JUST SEND DEFAULT
100 ; I CODE="A" JUST SEND THE ARRAY OF PROVIDERS
101 D POV^PXBUTL2(CLINIC,3)
102 N POV,X,CLNAME,STOP,LIST,NAME,NUMBER
103 I '$D(IORC) D TERM^PXBCC
104 I '$D(CODE) W !,"SEND PARAMETER = TO 'D'efault OR 'A'rray" Q
105 I $G(CODE)="D",$D(PXBPMT("DEF")) S NAME=$O(PXBPMT("DEF",0)) S PXBDPOV=NAME
106 I $G(CODE)="A" K PXBPMT("DEF") D
107 .S (POV,STOP)="" F S POV=$O(PXBPMT("POV",POV)) Q:POV="" Q:STOP=0 D
108 ..I '$D(PXBKY(POV)) S STOP=0
109 .I STOP="" Q
110 .S CLNAME=$P(^SC(CLINIC,0),"^",1)
111 .S X="Other ICD CODES associated with "_CLNAME_" clinic."
112 .W:PXBCNT<7 ! W !,?(IOM-$L(X))/2,IOINHI,X,IOINLOW K X
113 .S (POV,LIST)="" F S POV=$O(PXBPMT("POV",POV)) Q:POV="" D
114 ..I $D(PXBKY(+POV)) Q
115 ..S LIST=LIST_POV_" " I $L(LIST," ")>2 W !,?(IOM-$L(LIST))/2,LIST S LIST=""
116 I $G(LIST)]"" W !,?(IOM-$L(LIST))/2,LIST
117 Q
118 ;
119DIS ;----DISPLAY
120 Q
121 I $D(PXBPMT("POV",$P($P(ENTRY,"^",1),"*"))) W:PXBCNT>11 IORVON W ?37," --Clinic Associated--",IORVOFF
122 Q
123 ;
124CIA(X) ;Clinical Indicator Abbreviations
125 N V,I,CI S CI="SC^AO^IR^EC^MST^HNC^CV" W !
126 F I=1,7,2:1:6 S V=$P(X,U,I) W:V]"" ?(I*8),$P(CI,U,I),":",$S(V:"Y",1:"N")
127 Q
128 ;
129ARRAY ;Set POV entries into ^TMP("PXBDPOV",$J,"DSP" for display
130 N ENTRY,PX124,PXTLNS
131 S PXTMP="^TMP(""PXBDPOV"""_","_$J_","_"""DSP"")",(PXTLNS,PX124)=0
132 K @PXTMP
133 F S PX124=$O(PXBSAM(PX124)) Q:'PX124 D
134 .S PXTLNS=PXTLNS+1,ENTRY=PXBSAM(PX124)
135 .S PXBSAM(PX124,"LINE")=PXTLNS
136 .S @PXTMP@(PXTLNS,0)=PX124_U_ENTRY
137 .S PXTLNS=PXTLNS+1
138 .S @PXTMP@(PXTLNS,0)=0_U_PXBSAM(PX124,"I")
139 S PXBCNT=PXTLNS
140 Q
141 ;
Note: See TracBrowser for help on using the repository browser.