Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: SCRPW47

SCRPW47.m

Go to the documentation of this file. 
  1. SCRPW47 ;RENO/KEITH/MLR - Outpatient Diagnosis/Procedure Code Search (cont.) ;9/29/00 12:34pm
  1.  ;;5.3;Scheduling;**144,180,199,593**;AUG 13, 1993;Build 13
  1.  ;;07/22/99 ACS - Added CPT modifiers to the report
  1.  ;  *199*
  1.  ;   - Summary section correction (multiple divisions)
  1.  ;   - Addition of Secondary Division subscript variable: DIV0
  1.  ;   - Displaying only divisions with matching criterial in subheader
  1.  ;
  1.  N SDIV S SDIV=""
  1.  F  S SDIV=$O(^TMP("SCRPW",$J,SDIV)) Q:SDIV=""!SDOUT  D
  1.  . S DFN=0 F  S DFN=$O(^TMP("SCRPW",$J,SDIV,1,DFN)) Q:'DFN!SDOUT  D
  1.  .. S (DIV1,DIV0)=0 F  S DIV0=$O(^TMP("SCRPW",$J,SDIV,1,DFN,DIV0)) Q:'DIV0  D
  1.  ...; Screening "DR" or "PR" levels (SDZ) prior to setting print level
  1.  ...; Note:  Patient must have valid Diagnosis or Procedure to print
  1.  ... Q:$G(^TMP("SCRPW",$J,0,1,DFN,DIV0,SDZ))=""
  1.  ... S SDSTOP=SDSTOP+1 D:SDSTOP#1000=0 STOP Q:SDOUT
  1.  ... S SDPT0=$G(^DPT(DFN,0)),SDPTNA=$P(SDPT0,U)
  1.  ... S:$L(SDPTNA) ^TMP("SCRPW",$J,SDIV,2,SDPTNA,DFN,DIV0)=$P(SDPT0,U,9)
  1.  ;
  1.  G:SDOUT EXIT
  1.  D:$E(IOST)="C" DISP0^SCRPW23
  1.  K SDTIT
  1.  S SDTIT(1)="<*>  OUTPATIENT DIAGNOSIS/PROCEDURE CODE SEARCH  <*>"
  1.  D HINI^SCRPW46,BLD^SCRPW21
  1.  S SDTIT(2)="Report Parameters Selected"
  1.  D HDR G:SDOUT EXIT D PD1(0) G:SDOUT EXIT
  1.  ;if no data in file, exit from program
  1.  I '$D(^TMP("SCRPW",$J,0,1)) D  G EXIT
  1.  . K SDTIT(2) D HDR G:SDOUT EXIT
  1.  . S SDX="No activity found within selected report parameters!"
  1.  . W !!?(IOM-$L(SDX)\2),SDX
  1.  . Q
  1.  ;
  1.  I $P(SDDIV,U,2)="SELECTED DIVISIONS" D
  1.  . S SDI=0 F  S SDI=$O(SDDIV(SDI)) Q:'SDI  S SDIVL(SDDIV(SDI))=SDI
  1.  ;
  1.  I $P(SDDIV,U,2)="ALL DIVISIONS" D
  1.  . S SDI=0 F  S SDI=$O(^TMP("SCRPW",$J,0,SDI)) Q:'SDI  D
  1.  .. S SDX=$P($G(^DG(40.8,SDI,0)),U)
  1.  .. S:'$L(SDX) SDX="***UNKNOWN***"
  1.  .. S SDIVL(SDX)=SDI
  1.  ;
  1.  S:'$D(SDIVL) SDIVL($P(SDDIV,U,2))=$P(SDDIV,U)
  1.  D:$E(IOST)="C" DISP0^SCRPW23 S SDCOL=$S(IOM=80:0,1:26)
  1.  S SDIVN=""
  1.  F  S SDIVN=$O(SDIVL(SDIVN)) Q:SDIVN=""!SDOUT  D DPRT(SDIVL(SDIVN))
  1.  G:SDOUT EXIT S SDMD=0,SDMD=$O(^TMP("SCRPW",$J,SDMD)),SDMD=$O(^TMP("SCRPW",$J,SDMD)) D:SDMD DPRT(0)
  1.  I $E(IOST)="C",'SDOUT W ! N DIR S DIR(0)="E" D ^DIR
  1.  ;
  1. EXIT D END^SCRPW50
  1.  K %,%H,%I,%DT,DFN,DIC,DIR,DTOUT,DUOUT,S1,S2,SD,SDACT,SDAPF,SDBAD,SDC
  1.  K SDC1,SDCL,SDCOL,SDCPT,SDCRI,SDCT,SDD,SDDIV,SDDX,SDEXE,SDF,SDFF
  1.  K SDI,SDI2,SDII,SDIII,SDITX,SDIV,SDIVL,SDIVN,SDIXE,SDL,SDL1,SDLAB
  1.  K SDLAST,SDLF,SDLINE,SDLIST,SDLOC,SDLTH,SDMD,SDNUL,SDOE,SDOE0,SDOTX
  1.  K SDOUT,SDOXE,SDP,SDPAGE,SDPAR,SDPDIV,SDPNAM,SDPNOW,SDPT0,SDPTNA,SDR
  1.  K SDR1,SDR2,SDSEL,SDSSN,SDSTOP,SDSTR,SDT,SDTIT,SDTX,SDTXB,SDTY,SDUI
  1.  K SDUII,SDUIII,SDUIV,SDUJC,SDRESP,SDS1,SDS2,SDV,SDVAL,SDVAR,SDX,SDX2
  1.  K SDFMT,SDY,SDZ,X,X1,X2,X3,X4,Y,Z
  1.  Q  ;EXIT
  1.  ;
  1. HDR D HDR^SCRPW46 Q
  1.  ;
  1. HD1 ;Report subheader
  1.  Q:SDOUT
  1.  W !?(SDCOL),"Patient/Division:",?(SDCOL+26),"SSN:"
  1.  W ?(SDCOL+38),$S('$D(SD("LIST","P")):"Diagnoses:",'$D(SD("LIST","D")):"Procedures/Modifiers:",1:"Diagnoses/Procedures:")
  1.  W !?(SDCOL),$E(SDLINE,1,24),?(SDCOL+26),$E(SDLINE,1,10)
  1.  W ?(SDCOL+38),$E(SDLINE,1,42)
  1.  Q  ;HD1
  1.  ;
  1. STOP ;Check for stop task request
  1.  S:$D(ZTQUEUED) (SDOUT,ZTSTOP)=$S($$S^%ZTLOAD:1,1:0) Q
  1.  ;
  1. DPRT(SDV) ;Print report for a division
  1.  ;Required input: SDV=division ifn or '0' for summary
  1.  S SDIV=SDV  ;copying division #
  1.  D DHDR^SCRPW46(SDV,2,.SDTIT) S SDPAGE=1 D HDR Q:SDOUT
  1.  I '$D(^TMP("SCRPW",$J,SDV,2)) D
  1.  . S SDX="No activity found within selected report parameters for this division!"
  1.  . W !!?(IOM-$L(SDX)\2),SDX Q
  1.  D HD1 S (SDCT,SDDCT,DIVB)=0,(SDPNAM,SDPNAM2)="",SDF=$P(SDFMT,U)
  1.  F  S SDPNAM=$O(^TMP("SCRPW",$J,SDV,2,SDPNAM)) Q:SDPNAM=""!SDOUT  D
  1.  . S DFN=0 F  S DFN=$O(^TMP("SCRPW",$J,SDV,2,SDPNAM,DFN)) Q:'DFN!SDOUT  D
  1.  .. S SDCT=SDCT+1,DIV0=0
  1.  .. F  S DIV0=$O(^TMP("SCRPW",$J,SDV,2,SDPNAM,DFN,DIV0)) Q:DIV0=""  D
  1.  ... S SDDCT=SDDCT+1,SDSSN=^TMP("SCRPW",$J,SDV,2,SDPNAM,DFN,DIV0)
  1.  ... S SDPNAM2=SDPNAM_" "_DIV0
  1.  ... D DPRT1 W !
  1.  W !?(SDCOL),$E(SDLINE,1,80)
  1.  W !?(SDCOL),"TOTAL PATIENTS IDENTIFIED: ",SDCT
  1.  I SDV=0 W !?(SDCOL),"MULTI-DIVISION PATIENTS:   ",SDDCT-SDCT
  1.  Q
  1.  ;
  1. DPRT1 ;Prints name & ss# of line detail
  1.  D:$Y>(IOSL-6) HDR,HD1 Q:SDOUT
  1.  W !?(SDCOL),$E(SDPNAM2,1,24)
  1.  W ?(SDCOL+26),SDSSN
  1.  S SDLF=0
  1.  ;
  1.  D  ;Calling print format modules
  1.  . D PATIENT
  1.  . I SDF="V" D VISIT Q
  1.  . I SDF="E" D ENCNTR Q
  1.  . Q
  1.  Q  ;DPRT1
  1.  ;
  1. PATIENT ;Prints Patient Diagnosis/Procedures for all Types of Detail
  1.  N DIWL,DIWF,SDL2 S DIWL=1 S DIWF="C42|"
  1.  F SDI="DR","PR" I $D(^TMP("SCRPW",$J,0,1,DFN,DIV0,SDI)) D  Q:SDOUT
  1.  . S SDII="" F  S SDII=$O(^TMP("SCRPW",$J,0,1,DFN,DIV0,SDI,SDII)) Q:SDII=""!SDOUT  D
  1.  .. D:$Y>(IOSL-4) HDR,HD1 Q:SDOUT
  1.  .. D
  1.  ... W:SDLF ! Q
  1.  ... I DIV1'=DIV0 S DIV1=DIV0 W ! Q
  1.  ... Q
  1.  .. K ^UTILITY($J,"W") S X=$S(SDI="DR":"Dx: ",1:"Proc.: ")_SDII D ^DIWP S SDLF=1
  1.  .. F SDL2=1:1:^UTILITY($J,"W",DIWL) W:SDL2>1 ! W ?(SDCOL+38),$E(^UTILITY($J,"W",DIWL,SDL2,0),1,42)
  1.  ..; print mod and desc for current CPT (SDII)
  1.  ..; SDII2 = modifier and description
  1.  .. I $D(^TMP("SCRPW",$J,0,1,DFN,DIV0,SDI,SDII)) D
  1.  ... N SDII2 S SDII2=""
  1.  ... F  S SDII2=$O(^TMP("SCRPW",$J,0,1,DFN,DIV0,SDI,SDII,SDII2)) Q:'SDII2  D
  1.  .... D:$Y>(IOSL-4) HDR,HD1 Q:SDOUT
  1.  .... W !,?(SDCOL+47),"-",$E(SDII2,1,32)
  1.  .. Q
  1.  . Q
  1.  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)
  1.  ;
  1.  Q  ;PATIENT
  1.  ;
  1. VISIT ;Printing Type of Detail: Visits
  1.  S SDT=0
  1.  F  S SDT=$O(^TMP("SCRPW",$J,0,1,DFN,DIV0,"ACT",SDT)) Q:'SDT!SDOUT  D
  1.  . D:$Y>(IOSL-4) HDR,HD1 Q:SDOUT
  1.  . S Y=SDT X ^DD("DD") W !?(SDCOL+10),"Visit: ",Y Q
  1.  ;
  1.  Q  ;VISIT
  1.  ;
  1. ENCNTR ;Printing Type of Detail: ENCOUNTER
  1.  S SDT=0
  1.  F  S SDT=$O(^TMP("SCRPW",$J,0,1,DFN,DIV0,"ACT",SDT)) Q:'SDT!SDOUT  D
  1.  . S SDOE=0 F  S SDOE=$O(^TMP("SCRPW",$J,0,1,DFN,DIV0,"ACT",SDT,SDOE)) Q:'SDOE!SDOUT  D
  1.  .. D:$Y>(IOSL-4) HDR,HD1 Q:SDOUT
  1.  .. S SDOE0=^TMP("SCRPW",$J,0,1,DFN,DIV0,"ACT",SDT,SDOE)
  1.  .. S SDLOC=$P($G(^SC(+$P(SDOE0,U,4),0)),U)
  1.  .. S Y=SDT X ^DD("DD") W !?(SDCOL+10),"Encounter: ",$P(Y,":",1,2)
  1.  .. W ?(SDCOL+40),SDLOC
  1.  .. 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))
  1.  .. Q
  1.  Q  ;ENCNTR
  1.  ;
  1. APF(SDY,SDOE0,SDC) ;Print additional print fields
  1.  ;Required input: SDY=action acronym^major category^minor category
  1.  ;Required input: SDOE0=zeroeth node of OUTPATIENT ENCOUNTER record
  1.  ;Required input: SDC=column to begin output
  1.  N SDACT,SDX,SDI
  1.  D:$Y>(IOSL-4) HDR,HD1 Q:SDOUT  W !?(SDCOL+SDC),$P(SDY,U,3),":"
  1.  S SDACT=^TMP("SCRPW",$J,"ACT",$P(SDY,U)),SDLF=0,SDC1=SDC+2+$L($P(SDY,U,3))
  1.  K SDX X $P(SDACT,"~",7) S SDX="" F  S SDX=$O(SDX(SDX)) Q:SDX=""!SDOUT  D
  1.  .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
  1.  .Q
  1.  Q
  1.  ;
  1. PD1(SDI) ;Print parameters
  1.  ;Required input: SDI=0 for all division selections or division ifn
  1.  N SDLF,C S C=(IOM-80\2),SDLF=0 I SDI D PDP("Report for",SDDIV(SDI),1) Q:SDOUT
  1.  I 'SDI D PDP("Report for",SDDIV,2) Q:SDOUT  D
  1.  .F  S SDI=$O(SDDIV(SDI)) Q:'SDI!SDOUT  D PDP("Division",SDDIV(SDI),1)
  1.  Q:SDOUT  D PDP("Beginning date",SD("PBDT"),1,0,1) Q:SDOUT  D PDP("Ending date",SD("PEDT"),1) Q:SDOUT
  1.  S SDI="" F  S SDI=$O(SDPAR(SDI)) Q:SDI=""!SDOUT  D
  1.  .D PDP("Search element '"_SDI_"'",SDPAR(SDI),2,0,1) Q:SDOUT  S SDTY=$P(SDPAR(SDI),U)
  1.  .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
  1.  .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)
  1.  .Q
  1.  S SDI="" F  S SDI=$O(SDCRI(SDI)) Q:SDI=""!SDOUT  D
  1.  .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
  1.  ..S SDLF=SDLF+1 I $E(IOST)="C",SDLF#18=0 D WAIT Q:SDOUT
  1.  ..I $Y>(IOSL-3),$E(IOST)="P" D HDR Q:SDOUT
  1.  ..S SDX=SDOTX(SDII) W !?(IOM-$L(SDX)\2),SDX
  1.  ..Q
  1.  .Q
  1.  D PDP("Type of detail",SDFMT,2,0,1) Q:SDOUT
  1.  S SDIII=0 F SDI=2,1 S SDII=0 F  S SDII=$O(SDAPF(SDI,SDII)) Q:'SDII!SDOUT  D
  1.  .D PDP("Additional print fields",SDAPF(SDI,SDII),3,SDIII,'SDIII) S SDIII=1
  1.  D:$E(IOST)="C" WAIT Q
  1.  ;
  1. PDP(SDT,SDX,SDP,SDL,SDL1) ;Print parameter display line
  1.  ;Required input: SDT=parameter title
  1.  ;Required input: SDX=parameter value
  1.  ;Required input: SDP=$P of SDX to print
  1.  ;Optional input: SDL=1 to suppress title and do line feed
  1.  ;Optional input: SDL1=1 to do additional line feed
  1.  N DIWL,DIWF,SDL2 S DIWL=1 S DIWF="C"_(IOM\2+1)_"|"
  1.  S SDLF=SDLF+1 I $E(IOST)="C",SDLF#18=0 D WAIT Q:SDOUT
  1.  I $Y>(IOSL-3),$E(IOST)="P" D HDR Q:SDOUT
  1.  I $G(SDL1) W ! S SDLF=SDLF+1 I $E(IOST)="C",SDLF#18=0 D WAIT Q:SDOUT
  1.  W ! W:'$G(SDL) $J(SDT,(IOM-6\2)),":"
  1.  K ^UTILITY($J,"W") S X=$P(SDX,U,SDP) D ^DIWP
  1.  F SDL2=1:1:^UTILITY($J,"W",DIWL) D  S SDLF=SDLF+1 I $E(IOST)="C",SDLF#18=0 D WAIT Q:SDOUT
  1.  . I SDL2=1 W ?(IOM\2-1),$E(^UTILITY($J,"W",DIWL,SDL2,0),1,(IOM\2+1)) I 1
  1.  . E  W !,?(IOM\2-1),$E(^UTILITY($J,"W",DIWL,SDL2,0),1,(IOM\2+1))
  1.  Q
  1.  ;
  1. WAIT ;Do CRT pause
  1.  N DIR W ! S DIR(0)="E" D ^DIR S SDOUT=Y'=1 W ! Q