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

SCRPW16.m

Go to the documentation of this file. 
  1. SCRPW16 ;RENO/KEITH - Encounter 'Action Required' Report ; 01 Jan 99  9:27 PM
  1.  ;;5.3;Scheduling;**139,144,155,161,336,466,1015**;AUG 13, 1993;Build 21
  1.  N SD,SDDIV,ZTSAVE,%DT,DIR,DTOUT,DUOUT,X,Y
  1.  D TITL^SCRPW50("Encounter 'Action Required' Report")
  1.  G:'$$DIVA^SCRPW17(.SDDIV) EXIT
  1.  D SUBT^SCRPW50("**** Date Range Selection ****")
  1.  W ! S %DT="AEPX",%DT("A")="Beginning date: " D ^%DT G:Y<1 EXIT S SD("BDT")=Y
  1. EDT S %DT("A")="   Ending date: " W ! D ^%DT G:Y<1 EXIT
  1.  I Y<SD("BDT") W !!,$C(7),"End date cannot be before begin date!",! G EDT
  1.  S SD("EDT")=Y_.999999
  1.  D SUBT^SCRPW50("*** Report Format Selection ***")
  1.  S DIR(0)="S^D:DETAILED REPORT;S:STATISTICS ONLY",DIR("A")="Select report type",DIR("B")="DETAILED REPORT" D ^DIR G:($D(DTOUT)!$D(DUOUT)) EXIT S SD("STAT")=Y
  1.  G:'$$ASK^SCRPW17(0,0,.SD,"",$S(SD("STAT")="D":"A",1:"A^1"),1) EXIT
  1.  I SD("STAT")="D" K DIR S DIR(0)="Y",DIR("A")="Would you like a separate page for every clinic",DIR("B")="NO" W ! D ^DIR G:($D(DTOUT)!$D(DUOUT)) EXIT S SD("PAGE")=Y
  1.  W !!,"This report requires 132 column output.",! S ZTSAVE("SDDIV")="",ZTSAVE("SDDIV(")="",ZTSAVE("SD(")="" D EN^XUTMDEVQ("RUN^SCRPW16","Enc. 'Act. Req.' Rpt.",.ZTSAVE) G EXIT
  1.  ;
  1. RUN ;Print report
  1.  K ^TMP("SCRPW",$J),SDSEG,SDSTR,SDT S (SDOUT,SDLK)=0
  1.  ;If date range includes TODAY, update appointment status
  1.  I SD("BDT")'>DT,SD("EDT")'<DT D  G:SDOUT EXIT
  1.  .D LOCK Q:SDOUT!'SDLK
  1.  .N SDBEG,SDEND,X,%,%H,%I D NOW^%DTC S SDBEG=DT,SDEND=%
  1.  .S SDEND=($P(SDEND,".")-1)_"."_999999
  1.  .D EN^SDAMQ3(SDBEG,SDEND) K ^TMP("SDSTATS",$J) L -^SCRPW16("ACTION REQUIRED REPORT") Q
  1.  S SDT(2)=$$T2^SCRPW18(),SDDT=SD("BDT"),SDSEG=$$SEGS^SCRPW18(.SDSEG) D STR^SCRPW18(.SDSTR) S (SDOUT,SDSTOP)=0,SDMD="",SDMD=$O(SDDIV(SDMD)),SDMD=$O(SDDIV(SDMD)) S:$P(SDDIV,U,2)="ALL DIVISIONS" SDMD=1
  1.  F  S SDDT=$O(^SCE("B",SDDT)) Q:'SDDT!(SDDT>SD("EDT"))!SDOUT  S SDOE=0 F  S SDOE=$O(^SCE("B",SDDT,SDOE)) Q:'SDOE!SDOUT  D EVAL
  1.  G:SDOUT EXIT
  1.  S SDIV="" F  S SDIV=$O(^TMP("SCRPW",$J,SDIV)) Q:SDIV=""  D STOP Q:SDOUT  D
  1.  .S SDFCT(SDIV)=0,SDCG="" F  S SDCG=$O(^TMP("SCRPW",$J,SDIV,1,SDCG)) Q:SDCG=""  S SDTCT=0 D CT1 S ^TMP("SCRPW",$J,SDIV,1,SDCG)=SDTCT
  1.  .Q
  1.  G:SDOUT EXIT
  1.  S SDIV="" F  S SDIV=$O(SDDIV(SDIV)) Q:'SDIV  S SDIV(SDDIV(SDIV))=SDIV
  1.  I 'SDDIV,$P(SDDIV,U,2)'="ALL DIVISIONS" S SDIV($P(SDDIV,U,2))=$$PRIM^VASITE()
  1.  I $P(SDDIV,U,2)="ALL DIVISIONS" S SDI=0 F  S SDI=$O(^TMP("SCRPW",$J,SDI)) Q:'SDI  S SDX=$P($G(^DG(40.8,SDI,0)),U) S:$L(SDX) SDIV(SDX)=SDI
  1.  D HD1^SCRPW18 D:$E(IOST)="C" DISP0^SCRPW23 I '$O(^TMP("SCRPW",$J,0)) S SDIV=0 D DHDR^SCRPW40(3,.SDT) D HDR^SCRPW18(.SDT,"") Q:SDOUT  S SDX="No activity found within selected report parameters!" W !!?(IOM-$L(SDX)\2),SDX G EXIT
  1.  S SDIVN="" F  S SDIVN=$O(SDIV(SDIVN)) Q:SDIVN=""!SDOUT  S SDIV=SDIV(SDIVN) D DPRT(.SDIV)
  1.  S SDI=0,SDI=$O(^TMP("SCRPW",$J,SDI)),SDMD=$O(^TMP("SCRPW",$J,SDI))
  1.  G:SDOUT EXIT I SDMD S SDIV=0 D DPRT(.SDIV)
  1.  I 'SDOUT,$E(IOST)="C" N DIR S DIR(0)="E" D ^DIR
  1. EXIT K SD,SDARY,SDBDAY,SDCCT,SDCL,SDCLN,SDCT,SDDPT,SDDT,SDEDAY,SDFCT,SDFF,SDI,SDLINE,SDOE,SDOE0,SDORD,SDPAGE,SDPNOW,DFN,SDPT0,SDPTNA,SDR,SDSN,SDSTR
  1.  K SDT,SDTCT,SDCG,SDX,SDMD,SDSTOP,%,SDFOUND,SDDEF,SDCO,SDAP0,SDDIV,SDIV,SDIVN,SDCI,SDCLPT,SDCLPTC,SDDIS,SDV,SDSDV,SDSDVC0,SDSEG,SDTY,SDY,%DT
  1.  K SDLK,SCRPW16,SDCS,SDCO,SDZ,SDOUT,DIR,DTOUT,DUOUT,X,Y,ZTSAVE D KVA^VADPT,END^SCRPW50 Q
  1.  ;
  1. LOCK ;Prevent simultaneous runs of the appointment status update
  1.  F SDI=1:1 L +^SCRPW16("ACTION REQUIRED REPORT"):1 D  Q:SDI>600!SDOUT!SDLK
  1.  .I $T S SDLK=1 Q
  1.  .D:SDI#60=0 STOP
  1.  .Q
  1.  Q
  1.  ;
  1. DPRT(SDIV) ;Print report for a division
  1.  D DHDR^SCRPW40(3,.SDT) I '$D(^TMP("SCRPW",$J,SDIV)) D HDR^SCRPW18(.SDT,"") Q:SDOUT  S X="No 'action required' activity found for this division!" W !!?(132-$L(X)\2),X Q
  1.  D:SDIV&(SD("STAT")="D") DET^SCRPW18 Q:SDOUT  D STAT^SCRPW18 Q
  1.  ;
  1. STOP ;Check for stop task request
  1.  S:$G(ZTQUEUED) (SDOUT,ZTSTOP)=$S($$S^%ZTLOAD:1,1:0) Q
  1.  ;
  1. EVAL S SDSTOP=SDSTOP+1 I SDSTOP#3000=0 D STOP Q:SDOUT
  1.  S SDOE0=$$GETOE^SDOE(SDOE),SDIV=$P(SDOE0,U,11) Q:$P(SDOE0,U,6)!'SDIV  Q:$$STCK(SDOE0)  Q:'$$DIV(SDIV)
  1.  S SDCL=+$P(SDOE0,U,4),SDCLN=$S('SDCL:"**NONE**",1:$P(^SC(SDCL,0),U)),SDCG=$P($G(^SC(SDCL,0)),U,31),SDCG=$S(SD("FORMAT")'["G":"**NONE**",SDCG:$P(^SD(409.67,SDCG,0),U),1:"**NONE**")
  1.  I SD("FORMAT")="SC",'$D(SD("CLINIC",SDCLN)) Q
  1.  I SD("FORMAT")="RC",(($O(SD("CLINIC",""))]SDCLN)!(SDCLN]$O(SD("CLINIC",""),-1))) Q
  1.  I "SS^RS"[SD("FORMAT"),'$$STCO() Q
  1.  I SD("FORMAT")="SG",$P(SD("GROUP"),U,2)'=SDCG Q
  1.  S DFN=$P(SDOE0,U,2) Q:'DFN  D DEM^VADPT M SDDPT=VADM
  1.  I SD("ORDER")="A" S SDORD=SDDPT(1)
  1.  I SD("ORDER")="D" S SDORD=$P(SDOE0,U)
  1.  I SD("ORDER")="T" S SDSN=$P(SDDPT(2),U),SDORD=$E(SDSN,8,9)_$E(SDSN,6,7)_$E(SDSN,4,5)_$E(SDSN,1,3)_"."
  1.  K SDARY M SDARY=SDSEG S (SDFOUND,SDY)=0 I $$CHEK^SCRPW18(SDOE,.SDARY,.SDSTR) S SDI="" F  S SDI=$O(SDARY(SDI)) Q:SDI=""  S SDX="" F  S SDX=$O(SDARY(SDI,SDX)) Q:SDX=""  D SET(SDX)
  1.  K SDX D CLASK^SDCO2(SDOE,.SDX)
  1.  ; SD*5.3*336 so all existing and future classification types are pulled
  1.  I $D(SDX) S SDI=0 F  S SDI=$O(SDX(SDI)) Q:'SDI  I $P(SDX(SDI),U,2)="" D
  1.  . I '$D(^SD(409.41,SDI,0)) S SDX="Classification required" D SET(SDX) Q
  1.  . S SDX=$P($G(^SD(409.41,SDI,0)),U,1)_" classification required"
  1.  . D SET(SDX)
  1.  I 'SDFOUND,$P(SDOE0,U,8)=1,'$$CODT^SDCOU(DFN,SDDT,SDCL) S SDI=1,SDX="No check-out date" D SET(SDX)
  1.  I 'SDFOUND S SDCO="" D EN^SDCOM(SDOE,0,,.SDCO) Q:SDCO>0
  1.  I 'SDFOUND D
  1.  .K SDZ D GETDX^SDOE(SDOE,"SDZ") I '$G(SDZ) D SET("No diagnosis on file")
  1.  .K SDZ D GETPRV^SDOE(SDOE,"SDZ") I '$G(SDZ) D SET("No provider on file")
  1.  .K SDZ D GETCPT^SDOE(SDOE,"SDZ") I '$G(SDZ) D SET("No procedure code on file")
  1.  I 'SDFOUND S SDX="Unknown reason" D SET(SDX)
  1.  D EV1(SDIV) D:SDMD EV1(0)
  1.  Q
  1.  ;
  1. STCK(SDOE0) ;Check Status for action required
  1.  ;Returns 0 if status=action required (14) or
  1.  ;             status=inpatients (8) and check out date=""
  1.  ;        1 if non-count clinic, OOS and otherwise
  1.  I $P(SDOE0,U,4),'$$CLINIC^SDAMU($P(SDOE0,U,4)) Q 1
  1.  I $P(SDOE0,U,12)=8,$P(SDOE0,U,7)="" Q 0
  1.  I $P(SDOE0,U,12)'=14 Q 1
  1.  Q 0
  1.  ;
  1. EV1(SDIV) S ^TMP("SCRPW",$J,SDIV,1,SDCG,SDCLN,SDORD,DFN,SDOE)=SDOE0,^TMP("SCRPW",$J,SDIV,3,DFN)=SDDPT(1)_U_SDDPT(2)
  1.  Q
  1.  ;
  1. DIV(SDIV) ;Evaluate division
  1.  ;Required input: SDIV=division ifn
  1.  Q:'SDDIV 1  Q $D(SDDIV(SDIV))
  1.  ;
  1. STCO() ;Evaluate Stop Code
  1.  Q:'SDCL 0  S SDCS=$P($G(^SC(SDCL,0)),U,7) Q:'SDCS 0  S SDCS=$P($G(^DIC(40.7,SDCS,0)),U,2) Q:'SDCS 0
  1.  I SD("FORMAT")="SS" Q $D(SD("STOPCODE",SDCS))
  1.  I (($O(SD("STOPCODE",""))]SDCS)!(SDCS]$O(SD("STOPCODE",""),-1))) Q 0
  1.  Q 1
  1.  ;
  1. SET(SDX) D SET1(SDIV) D:SDMD SET1(0) Q
  1.  ;
  1. SET1(SDIV) S SDY=SDY+1,^TMP("SCRPW",$J,SDIV,1,SDCG,SDCLN,SDORD,DFN,SDOE,SDY)=SDX
  1.  S ^TMP("SCRPW",$J,SDIV,2,SDCG,SDX)=$G(^TMP("SCRPW",$J,SDIV,2,SDCG,SDX))+1,SDFOUND=1
  1.  Q
  1.  ;
  1. CT1 S SDCLN="" F  S SDCLN=$O(^TMP("SCRPW",$J,SDIV,1,SDCG,SDCLN)) Q:SDCLN=""  S SDCCT=0 D CT2 S ^TMP("SCRPW",$J,SDIV,1,SDCG,SDCLN)=SDCCT
  1.  Q
  1.  ;
  1. CT2 S SDORD="" F  S SDORD=$O(^TMP("SCRPW",$J,SDIV,1,SDCG,SDCLN,SDORD)) Q:SDORD=""  S DFN="" F  S DFN=$O(^TMP("SCRPW",$J,SDIV,1,SDCG,SDCLN,SDORD,DFN)) Q:DFN=""  D CT3
  1.  Q
  1.  ;
  1. CT3 S SDOE=0 F  S SDOE=$O(^TMP("SCRPW",$J,SDIV,1,SDCG,SDCLN,SDORD,DFN,SDOE)) Q:'SDOE  S SDFCT(SDIV)=SDFCT(SDIV)+1,SDTCT=SDTCT+1,SDCCT=SDCCT+1
  1.  Q