| 1 | SCRPW47 ;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 | ;
|
---|
| 50 | EXIT 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 | ;
|
---|
| 61 | HDR D HDR^SCRPW46 Q
|
---|
| 62 | ;
|
---|
| 63 | HD1 ;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 | ;
|
---|
| 71 | STOP ;Check for stop task request
|
---|
| 72 | S:$D(ZTQUEUED) (SDOUT,ZTSTOP)=$S($$S^%ZTLOAD:1,1:0) Q
|
---|
| 73 | ;
|
---|
| 74 | DPRT(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 | ;
|
---|
| 94 | DPRT1 ;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 | ;
|
---|
| 107 | PATIENT ;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 | ;
|
---|
| 129 | VISIT ;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 | ;
|
---|
| 137 | ENCNTR ;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 | ;
|
---|
| 150 | APF(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 | ;
|
---|
| 162 | PD1(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 | ;
|
---|
| 185 | PDP(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 | ;
|
---|
| 196 | WAIT ;Do CRT pause
|
---|
| 197 | N DIR W ! S DIR(0)="E" D ^DIR S SDOUT=Y'=1 W ! Q
|
---|