source: FOIAVistA/tag/r/SCHEDULING-SD-SC/SCRPW47.m@ 636

Last change on this file since 636 was 628, checked in by George Lilly, 14 years ago

initial load of FOIAVistA 6/30/08 version
File size: 8.1 KB
Line 
1SCRPW47 ;RENO/KEITH/MLR - Outpatient Diagnosis/Procedure Code Search (cont.) ; 9/29/00 12:34pm
2 ;;5.3;Scheduling;**144,180,199**;AUG 13, 1993
3 ;;07/22/99 ACS - Added CPT modifiers to the report
4 ; *199*
5 ; - Summary section correction (multiple divisions)
6 ; - Addition of Secondary Division subscript variable: DIV0
7 ; - Displaying only divisions with matching criterial in subheader
8 ;
9 N SDIV S SDIV=""
10 F S SDIV=$O(^TMP("SCRPW",$J,SDIV)) Q:SDIV=""!SDOUT D
11 . S DFN=0 F S DFN=$O(^TMP("SCRPW",$J,SDIV,1,DFN)) Q:'DFN!SDOUT D
12 .. S (DIV1,DIV0)=0 F S DIV0=$O(^TMP("SCRPW",$J,SDIV,1,DFN,DIV0)) Q:'DIV0 D
13 ...; Screening "DR" or "PR" levels (SDZ) prior to setting print level
14 ...; Note: Patient must have valid Diagnosis or Procedure to print
15 ... Q:$G(^TMP("SCRPW",$J,0,1,DFN,DIV0,SDZ))=""
16 ... S SDSTOP=SDSTOP+1 D:SDSTOP#1000=0 STOP Q:SDOUT
17 ... S SDPT0=$G(^DPT(DFN,0)),SDPTNA=$P(SDPT0,U)
18 ... S:$L(SDPTNA) ^TMP("SCRPW",$J,SDIV,2,SDPTNA,DFN,DIV0)=$P(SDPT0,U,9)
19 ;
20 G:SDOUT EXIT
21 D:$E(IOST)="C" DISP0^SCRPW23
22 K SDTIT
23 S SDTIT(1)="<*> OUTPATIENT DIAGNOSIS/PROCEDURE CODE SEARCH <*>"
24 D HINI^SCRPW46,BLD^SCRPW21
25 S SDTIT(2)="Report Parameters Selected"
26 D HDR G:SDOUT EXIT D PD1(0) G:SDOUT EXIT
27 ;if no data in file, exit from program
28 I '$D(^TMP("SCRPW",$J,0,1)) D G EXIT
29 . K SDTIT(2) D HDR G:SDOUT EXIT
30 . S SDX="No activity found within selected report parameters!"
31 . W !!?(IOM-$L(SDX)\2),SDX
32 . Q
33 ;
34 I $P(SDDIV,U,2)="SELECTED DIVISIONS" D
35 . S SDI=0 F S SDI=$O(SDDIV(SDI)) Q:'SDI S SDIVL(SDDIV(SDI))=SDI
36 ;
37 I $P(SDDIV,U,2)="ALL DIVISIONS" D
38 . S SDI=0 F S SDI=$O(^TMP("SCRPW",$J,0,SDI)) Q:'SDI D
39 .. S SDX=$P($G(^DG(40.8,SDI,0)),U)
40 .. S:'$L(SDX) SDX="***UNKNOWN***"
41 .. S SDIVL(SDX)=SDI
42 ;
43 S:'$D(SDIVL) SDIVL($P(SDDIV,U,2))=$P(SDDIV,U)
44 D:$E(IOST)="C" DISP0^SCRPW23 S SDCOL=$S(IOM=80:0,1:26)
45 S SDIVN=""
46 F S SDIVN=$O(SDIVL(SDIVN)) Q:SDIVN=""!SDOUT D DPRT(SDIVL(SDIVN))
47 G:SDOUT EXIT S SDMD=0,SDMD=$O(^TMP("SCRPW",$J,SDMD)),SDMD=$O(^TMP("SCRPW",$J,SDMD)) D:SDMD DPRT(0)
48 I $E(IOST)="C",'SDOUT W ! N DIR S DIR(0)="E" D ^DIR
49 ;
50EXIT D END^SCRPW50
51 K %,%H,%I,%DT,DFN,DIC,DIR,DTOUT,DUOUT,S1,S2,SD,SDACT,SDAPF,SDBAD,SDC
52 K SDC1,SDCL,SDCOL,SDCPT,SDCRI,SDCT,SDD,SDDIV,SDDX,SDEXE,SDF,SDFF
53 K SDI,SDI2,SDII,SDIII,SDITX,SDIV,SDIVL,SDIVN,SDIXE,SDL,SDL1,SDLAB
54 K SDLAST,SDLF,SDLINE,SDLIST,SDLOC,SDLTH,SDMD,SDNUL,SDOE,SDOE0,SDOTX
55 K SDOUT,SDOXE,SDP,SDPAGE,SDPAR,SDPDIV,SDPNAM,SDPNOW,SDPT0,SDPTNA,SDR
56 K SDR1,SDR2,SDSEL,SDSSN,SDSTOP,SDSTR,SDT,SDTIT,SDTX,SDTXB,SDTY,SDUI
57 K SDUII,SDUIII,SDUIV,SDUJC,SDRESP,SDS1,SDS2,SDV,SDVAL,SDVAR,SDX,SDX2
58 K SDFMT,SDY,SDZ,X,X1,X2,X3,X4,Y,Z
59 Q ;EXIT
60 ;
61HDR D HDR^SCRPW46 Q
62 ;
63HD1 ;Report subheader
64 Q:SDOUT
65 W !?(SDCOL),"Patient/Division:",?(SDCOL+26),"SSN:"
66 W ?(SDCOL+38),$S('$D(SD("LIST","P")):"Diagnoses:",'$D(SD("LIST","D")):"Procedures/Modifiers:",1:"Diagnoses/Procedures:")
67 W !?(SDCOL),$E(SDLINE,1,24),?(SDCOL+26),$E(SDLINE,1,10)
68 W ?(SDCOL+38),$E(SDLINE,1,42)
69 Q ;HD1
70 ;
71STOP ;Check for stop task request
72 S:$D(ZTQUEUED) (SDOUT,ZTSTOP)=$S($$S^%ZTLOAD:1,1:0) Q
73 ;
74DPRT(SDV) ;Print report for a division
75 ;Required input: SDV=division ifn or '0' for summary
76 S SDIV=SDV ;copying division #
77 D DHDR^SCRPW46(SDV,2,.SDTIT) S SDPAGE=1 D HDR Q:SDOUT
78 I '$D(^TMP("SCRPW",$J,SDV,2)) D
79 . S SDX="No activity found within selected report parameters for this division!"
80 . W !!?(IOM-$L(SDX)\2),SDX Q
81 D HD1 S (SDCT,SDDCT,DIVB)=0,(SDPNAM,SDPNAM2)="",SDF=$P(SDFMT,U)
82 F S SDPNAM=$O(^TMP("SCRPW",$J,SDV,2,SDPNAM)) Q:SDPNAM=""!SDOUT D
83 . S DFN=0 F S DFN=$O(^TMP("SCRPW",$J,SDV,2,SDPNAM,DFN)) Q:'DFN!SDOUT D
84 .. S SDCT=SDCT+1,DIV0=0
85 .. F S DIV0=$O(^TMP("SCRPW",$J,SDV,2,SDPNAM,DFN,DIV0)) Q:DIV0="" D
86 ... S SDDCT=SDDCT+1,SDSSN=^TMP("SCRPW",$J,SDV,2,SDPNAM,DFN,DIV0)
87 ... S SDPNAM2=SDPNAM_" "_DIV0
88 ... D DPRT1 W !
89 W !?(SDCOL),$E(SDLINE,1,80)
90 W !?(SDCOL),"TOTAL PATIENTS IDENTIFIED: ",SDCT
91 I SDV=0 W !?(SDCOL),"MULTI-DIVISION PATIENTS: ",SDDCT-SDCT
92 Q
93 ;
94DPRT1 ;Prints name & ss# of line detail
95 D:$Y>(IOSL-6) HDR,HD1 Q:SDOUT
96 W !?(SDCOL),$E(SDPNAM2,1,24)
97 W ?(SDCOL+26),SDSSN
98 S SDLF=0
99 ;
100 D ;Calling print format modules
101 . D PATIENT
102 . I SDF="V" D VISIT Q
103 . I SDF="E" D ENCNTR Q
104 . Q
105 Q ;DPRT1
106 ;
107PATIENT ;Prints Patient Diagnosis/Procedures for all Types of Detail
108 F SDI="DR","PR" I $D(^TMP("SCRPW",$J,0,1,DFN,DIV0,SDI)) D Q:SDOUT
109 . S SDII="" F S SDII=$O(^TMP("SCRPW",$J,0,1,DFN,DIV0,SDI,SDII)) Q:SDII=""!SDOUT D
110 .. D:$Y>(IOSL-4) HDR,HD1 Q:SDOUT
111 .. D
112 ... W:SDLF ! Q
113 ... I DIV1'=DIV0 S DIV1=DIV0 W ! Q
114 ... Q
115 .. W ?(SDCOL+38),$E($S(SDI="DR":"Dx: ",1:"Proc.: ")_SDII,1,42) S SDLF=1
116 ..; print mod and desc for current CPT (SDII)
117 ..; SDII2 = modifier and description
118 .. I $D(^TMP("SCRPW",$J,0,1,DFN,DIV0,SDI,SDII)) D
119 ... N SDII2 S SDII2=""
120 ... F S SDII2=$O(^TMP("SCRPW",$J,0,1,DFN,DIV0,SDI,SDII,SDII2)) Q:'SDII2 D
121 .... D:$Y>(IOSL-4) HDR,HD1 Q:SDOUT
122 .... W !,?(SDCOL+47),"-",$E(SDII2,1,32)
123 .. Q
124 . Q
125 S SDI=0 F S SDI=$O(SDAPF(2,SDI)) Q:'SDI!SDOUT S SDOE0=U_DFN_U,SDY=SDAPF(2,SDI) D APF(SDY,SDOE0,5)
126 ;
127 Q ;PATIENT
128 ;
129VISIT ;Printing Type of Detail: Visits
130 S SDT=0
131 F S SDT=$O(^TMP("SCRPW",$J,0,1,DFN,DIV0,"ACT",SDT)) Q:'SDT!SDOUT D
132 . D:$Y>(IOSL-4) HDR,HD1 Q:SDOUT
133 . S Y=SDT X ^DD("DD") W !?(SDCOL+10),"Visit: ",Y Q
134 ;
135 Q ;VISIT
136 ;
137ENCNTR ;Printing Type of Detail: ENCOUNTER
138 S SDT=0
139 F S SDT=$O(^TMP("SCRPW",$J,0,1,DFN,DIV0,"ACT",SDT)) Q:'SDT!SDOUT D
140 . S SDOE=0 F S SDOE=$O(^TMP("SCRPW",$J,0,1,DFN,DIV0,"ACT",SDT,SDOE)) Q:'SDOE!SDOUT D
141 .. D:$Y>(IOSL-4) HDR,HD1 Q:SDOUT
142 .. S SDOE0=^TMP("SCRPW",$J,0,1,DFN,DIV0,"ACT",SDT,SDOE)
143 .. S SDLOC=$P($G(^SC(+$P(SDOE0,U,4),0)),U)
144 .. S Y=SDT X ^DD("DD") W !?(SDCOL+10),"Encounter: ",$P(Y,":",1,2)
145 .. W ?(SDCOL+40),SDLOC
146 .. S SDI=0 F S SDI=$O(SDAPF(1,SDI)) Q:'SDI!SDOUT S SDY=SDAPF(1,SDI) D APF(SDY,SDOE0,$S($D(SDAPF(2)):15,1:25))
147 .. Q
148 Q ;ENCNTR
149 ;
150APF(SDY,SDOE0,SDC) ;Print additional print fields
151 ;Required input: SDY=action acronym^major category^minor category
152 ;Required input: SDOE0=zeroeth node of OUTPATIENT ENCOUNTER record
153 ;Required input: SDC=column to begin output
154 N SDACT,SDX,SDI
155 D:$Y>(IOSL-4) HDR,HD1 Q:SDOUT W !?(SDCOL+SDC),$P(SDY,U,3),":"
156 S SDACT=^TMP("SCRPW",$J,"ACT",$P(SDY,U)),SDLF=0,SDC1=SDC+2+$L($P(SDY,U,3))
157 K SDX X $P(SDACT,"~",7) S SDX="" F S SDX=$O(SDX(SDX)) Q:SDX=""!SDOUT D
158 .D:$Y>(IOSL-3) HDR,HD1 Q:SDOUT W:SDLF ! W ?(SDCOL+SDC1),$E($P(SDX(SDX),U,2),1,(80-SDC1)) S SDLF=1
159 .Q
160 Q
161 ;
162PD1(SDI) ;Print parameters
163 ;Required input: SDI=0 for all division selections or division ifn
164 N SDLF,C S C=(IOM-80\2),SDLF=0 I SDI D PDP("Report for",SDDIV(SDI),1) Q:SDOUT
165 I 'SDI D PDP("Report for",SDDIV,2) Q:SDOUT D
166 .F S SDI=$O(SDDIV(SDI)) Q:'SDI!SDOUT D PDP("Division",SDDIV(SDI),1)
167 Q:SDOUT D PDP("Beginning date",SD("PBDT"),1,0,1) Q:SDOUT D PDP("Ending date",SD("PEDT"),1) Q:SDOUT
168 S SDI="" F S SDI=$O(SDPAR(SDI)) Q:SDI=""!SDOUT D
169 .D PDP("Search element '"_SDI_"'",SDPAR(SDI),2,0,1) Q:SDOUT S SDTY=$P(SDPAR(SDI),U)
170 .I SDTY["L" S SDLAB=$S(SDTY["D":"Diagnosis",1:"Procedure") S SDII=0 F S SDII=$O(SDPAR(SDI,SDII)) Q:'SDII D PDP(SDLAB,SDPAR(SDI,SDII),1) Q:SDOUT
171 .I SDTY["R" S SDVAL=$O(SDPAR(SDI,"")) D PDP("From",SDVAL,1) Q:SDOUT S SDVAL=$O(SDPAR(SDI,SDVAL)) D PDP("To",SDVAL,1)
172 .Q
173 S SDI="" F S SDI=$O(SDCRI(SDI)) Q:SDI=""!SDOUT D
174 .D PDP("Combine logic",SDI,1,0,1) Q:SDOUT M SDITX=SDCRI(SDI) D WRAP^SCRPW45(.SDITX,.SDOTX,,,60,"") S SDII="" F S SDII=$O(SDOTX(SDII)) Q:SDII=""!SDOUT D
175 ..S SDLF=SDLF+1 I $E(IOST)="C",SDLF#18=0 D WAIT Q:SDOUT
176 ..I $Y>(IOSL-3),$E(IOST)="P" D HDR Q:SDOUT
177 ..S SDX=SDOTX(SDII) W !?(IOM-$L(SDX)\2),SDX
178 ..Q
179 .Q
180 D PDP("Type of detail",SDFMT,2,0,1) Q:SDOUT
181 S SDIII=0 F SDI=2,1 S SDII=0 F S SDII=$O(SDAPF(SDI,SDII)) Q:'SDII!SDOUT D
182 .D PDP("Additional print fields",SDAPF(SDI,SDII),3,SDIII,'SDIII) S SDIII=1
183 D:$E(IOST)="C" WAIT Q
184 ;
185PDP(SDT,SDX,SDP,SDL,SDL1) ;Print parameter display line
186 ;Required input: SDT=parameter title
187 ;Required input: SDX=parameter value
188 ;Required input: SDP=$P of SDX to print
189 ;Optional input: SDL=1 to suppress title and do line feed
190 ;Optional input: SDL1=1 to do additional line feed
191 S SDLF=SDLF+1 I $E(IOST)="C",SDLF#18=0 D WAIT Q:SDOUT
192 I $Y>(IOSL-3),$E(IOST)="P" D HDR Q:SDOUT
193 I $G(SDL1) W ! S SDLF=SDLF+1 I $E(IOST)="C",SDLF#18=0 D WAIT Q:SDOUT
194 W ! W:'$G(SDL) $J(SDT,(IOM-6\2)),":" W ?(IOM\2-1),$P(SDX,U,SDP) Q
195 ;
196WAIT ;Do CRT pause
197 N DIR W ! S DIR(0)="E" D ^DIR S SDOUT=Y'=1 W ! Q
Note: See TracBrowser for help on using the repository browser.