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

SCRPW81.m

Go to the documentation of this file. 
  1. SCRPW81 ; ALB/SCK - SCDX AMB CARE CLOSEOUT RPT FOR MT INDICATOR = U ; 9 JULY 2003
  1.  ;;5.3;Scheduling;**302,440,474,1015**;AUG 13, 1993;Build 21
  1.  ;
  1. EN ; Main entry point for report
  1.  N DIR,DIRUT,SDBEG,SDEND,RSLT,Y,X
  1.  ;
  1.  S DIR("A")="Please select fiscal year",DIR(0)="SM^A:Previous Fiscal Year;B:Current Fiscal Year;O:Other Date Range"
  1.  S DIR("B")="B"
  1.  S DIR("?")="You may select either the previous fiscal year (A) or the current fiscal year (B).  Select (O) if you choose to specify your own date range."
  1.  D ^DIR K DIR
  1.  Q:$D(DIRUT)
  1.  S RSLT=Y
  1.  ;
  1.  I RSLT="A" D 
  1.  . D PASTYR(.SDBEG,.SDEND)
  1.  E  I RSLT="B" D
  1.  . D CURYR(.SDBEG,.SDEND)
  1.  E  D
  1.  . D GETDT(.SDBEG,.SDEND)
  1.  Q:'$G(SDBEG)!('$G(SDEND))
  1.  W !!?3,"Date Range: "_$$FMTE^XLFDT(SDBEG)_" to "_$$FMTE^XLFDT(SDEND)
  1.  ;
  1.  N X,Y,IORVON,IORVOFF
  1.  S X="IORVON;IORVOFF"
  1.  D ENDR^%ZISS
  1.  W:$D(IORVON) IORVON
  1.  W !,"A 132-Column printer is required for this report."
  1.  W !,"This report will NOT print correctly to the screen!"
  1.  W:$D(IORVOFF) IORVOFF
  1.  ;
  1.  N ZTSAVE,ZTRTN,ZTDESC,POP,%ZIS
  1.  S %ZIS="Q" D ^%ZIS G:POP EXIT
  1.  I $D(IO("Q")) D  Q
  1.  . S ZTSAVE("SDBEG")="",ZTSAVE("SDEND")="",ZTSAVE("DUZ")=""
  1.  . S ZTRTN="RUN^SCRPW81"
  1.  . S ZTDESC="XMITED OE MT=U RPT"
  1.  . D ^%ZTLOAD D HOME^%ZIS K IO("Q")
  1.  D RUN
  1.  D ^%ZISC
  1. EXIT S:$D(ZTQUEUED) ZTREQ="@" Q
  1.  ;
  1. RUN ; Run report
  1.  U IO
  1.  K ^TMP("SCDX MTU",$J),^TMP("SCDX ASORT",$J)
  1.  ;
  1.  D BLD(SDBEG,SDEND)
  1.  D CHKMT
  1.  D SRTNAME
  1.  D MAIL
  1.  D PRINT
  1.  K ^TMP("SCDX MTU",$J),^TMP("SCDX ASORT",$J)
  1.  Q
  1.  ;
  1. PASTYR(SDBEG,SDEND) ; Set dates for previous fiscal year
  1.  N CURYR,PRVYR,CURMN,%I
  1.  ;
  1.  D NOW^%DTC
  1.  S CURYR=%I(3),CURMN=%I(1)
  1.  I CURMN>9 D
  1.  . S CURYR=CURYR+1
  1.  S PRVYR=CURYR-1
  1.  S SDEND=$$FMADD^XLFDT(PRVYR_"1001",-1)
  1.  S SDBEG=$$FMADD^XLFDT(PRVYR_"1001",-365)
  1.  Q
  1.  ;
  1. CURYR(SDBEG,SDEND) ; Set dates for current fiscal year
  1.  N CURYR,CURMN,%I
  1.  ;
  1.  D NOW^%DTC
  1.  S CURYR=%I(3),CURMN=%I(1)
  1.  I CURMN<10 D
  1.  . S CURYR=CURYR-1
  1.  S SDBEG=CURYR_"1001"
  1.  S SDEND=$P($$NOW^XLFDT,".")
  1.  Q
  1.  ;
  1. GETDT(SDBEG,SDEND) ;  Get beginning and ending date for search
  1.  ; Output   SDBEG   Beginning for date range
  1.  ;          SDEND   End of date range
  1.  ;          result  1 - If function successful
  1.  ;                  0 - If function NOT successful (User quit)
  1.  ;
  1.  N DIR,DIRUT,Y
  1.  ;
  1.  W !!?3,"You have selected to specify your own date range.  Please note that by"
  1.  W !?3,"doing so you may not generate an accurate picture of the AMB CARE"
  1.  W !?3,"closeouts where the means test indicator equals 'U'.",!
  1.  ;
  1.  S DIR(0)="DAO^:DT:EX"
  1.  S DIR("A")="Beginning Date: "
  1.  S DIR("?")="^D HELP^%DTC"
  1.  D ^DIR
  1.  I $D(DIRUT) D  Q
  1.  . S SDBEG=0
  1.  S SDBEG=Y
  1.  ;
  1.  S DIR(0)="DAO^:DT:EX"
  1.  S DIR("A")="Ending Date: "
  1.  D ^DIR
  1.  I $D(DIRUT) D  Q
  1.  . S SDEND=0
  1.  S SDEND=Y
  1.  Q
  1.  ;
  1. BLD(SDBEG,SDEND) ;  Build list of patient OE's for date range
  1.  ; Input   SDBEG
  1.  ;         SDEND
  1.  ;
  1.  N SDX,SDMAX,SDOEI,CNT,NODE,SDOEX,SDLOC
  1.  ;
  1.  S SDX=$$FMADD^XLFDT(SDBEG,0,0,0,-1) ; set inital search DT to beginning date minus one second
  1.  S SDMAX=$$FMADD^XLFDT(SDEND,0,23,59,59) ; set search end date to end date plus one day
  1.  ;
  1.  S ^TMP("SCDX MTU",$J,0,"BEGIN")=$H
  1.  F  S SDX=$O(^SCE("B",SDX)) Q:'SDX  D  Q:SDX>SDMAX
  1.  . S SDOEI=0
  1.  . F  S SDOEI=$O(^SCE("B",SDX,SDOEI)) Q:'SDOEI  D
  1.  . . S NODE=$G(^SCE(SDOEI,0))
  1.  . . Q:$P(NODE,U,6)>0  ; Quit if not parent encounter
  1.  . . Q:$P(NODE,U,8)>3  ; Quit if Originating process is for credit stop code
  1.  . . S SDLOC=+$P(NODE,U,4)
  1.  . . Q:$$GET1^DIQ(44,SDLOC,2502,"I")="Y"  ; Quit if non-count clinic
  1.  . . S SDOEX=$O(^SD(409.73,"AENC",SDOEI,0))
  1.  . . Q:'$P(NODE,U,2)
  1.  . . S ^TMP("SCDX MTU",$J,$P(NODE,U,2),SDOEI)=$P(NODE,U,1)_U_SDOEX
  1.  . . S ^TMP("SCDX MTU",$J,0,"CNT")=$G(^TMP("SCDX MTU",$J,0,"CNT"))+1
  1.  S ^TMP("SCDX MTU",$J,0,"END")=$H
  1.  Q
  1.  ;
  1. CHKMT ; Clean out all except those meeting the MT=U conditions
  1.  N DFN,SDOEI,SDOEDT,SDMT,SDO,SDR,SDN,SDAT,SDEC,SDMTI,SDMTT
  1.  ;
  1.  S DFN=0
  1.  F  S DFN=$O(^TMP("SCDX MTU",$J,DFN)) Q:'DFN  D
  1.  . I '$D(^DGMT(408.31,"C",DFN)) D  Q  ; No MT Data, bypass patient
  1.  . . K ^TMP("SCDX MTU",$J,DFN)
  1.  . S (SDR,SDO,SDN,SDOEI)=0
  1.  . F  S SDOEI=$O(^TMP("SCDX MTU",$J,DFN,SDOEI)) Q:'SDOEI  D
  1.  . . S SDOEDT=$P($G(^TMP("SCDX MTU",$J,DFN,SDOEI)),U,1)
  1.  . . Q:'SDOEDT
  1.  . . S SDEC=$$GET1^DIQ(409.68,SDOEI,.13,"I")
  1.  . . S SDAT=$$GET1^DIQ(409.68,SDOEI,.1,"I")
  1.  . . S SDMTI=$$MTI^SCDXUTL0(DFN,SDOEDT,SDEC,SDAT,SDOEI)
  1.  . . I SDMTI'="U" D  Q
  1.  . . . K ^TMP("SCDX MTU",$J,DFN)
  1.  . . S SDMTT=$$LST^DGMTU(DFN,SDOEDT,1) I $P(SDMTT,U,4)="N" D  Q
  1.  . . . K ^TMP("SCDX MTU",$J,DFN)
  1.  . . S $P(^TMP("SCDX MTU",$J,DFN,SDOEI),U,4)=SDMTI
  1.  S ^TMP("SCDX MTU",$J,0,"END")=$H K SDMTT
  1.  Q
  1.  ;
  1. SRTNAME ; Sort remaining encounters by patient name and OE date
  1.  N DFN,SDOEI,SDNAME,SDOEDT
  1.  ;
  1.  S DFN=0
  1.  F  S DFN=$O(^TMP("SCDX MTU",$J,DFN)) Q:'DFN  D
  1.  . S SDNAME=$$GET1^DIQ(2,DFN,.01)
  1.  . Q:SDNAME']""
  1.  . S ^TMP("SCDX MTU",$J,0,"PATNUM")=$G(^TMP("SCDX MTU",$J,0,"PATNUM"))+1
  1.  . S SDOEI=0
  1.  . F  S SDOEI=$O(^TMP("SCDX MTU",$J,DFN,SDOEI)) Q:'SDOEI  D
  1.  . . S SDOEDT=$P(^TMP("SCDX MTU",$J,DFN,SDOEI),U,1)
  1.  . . S ^TMP("SCDX ASORT",$J,SDNAME,SDOEDT)=$P(^TMP("SCDX MTU",$J,DFN,SDOEI),U,2)_U_SDOEI_U_DFN_U_$P(^TMP("SCDX MTU",$J,DFN,SDOEI),U,4)
  1.  . . S ^TMP("SCDX MTU",$J,0,"FINAL CNT")=$G(^TMP("SCDX MTU",$J,0,"FINAL CNT"))+1
  1.  S ^TMP("SCDX MTU",$J,0,"END2")=$H
  1.  Q
  1.  ;
  1. MAIL ; send message with report statistics
  1.  N MSG,XMSUB,XMY,XMTEXT,XMDUZ
  1.  ;
  1.  S MSG(1)="Date Range for Report           "_$$FMTE^XLFDT(SDBEG,2)_" to "_$$FMTE^XLFDT(SDEND,2)
  1.  S MSG(2)=""
  1.  S MSG(3)="Report Started                  "_$$HTE^XLFDT(^TMP("SCDX MTU",$J,0,"BEGIN"),2)
  1.  S MSG(4)="Report Finished                 "_$$HTE^XLFDT(^TMP("SCDX MTU",$J,0,"END2"),2)
  1.  S MSG(5)="Total Time for Report           "_$$HDIFF^XLFDT(^TMP("SCDX MTU",$J,0,"END2"),^TMP("SCDX MTU",$J,0,"BEGIN"),3)
  1.  S MSG(6)=""
  1.  S MSG(7)="Outpatient Encounters Scanned   "_$J($FN(+$G(^TMP("SCDX MTU",$J,0,"CNT")),","),20)
  1.  S MSG(8)="Outpatient Encounters Reported  "_$J($FN(+$G(^TMP("SCDX MTU",$J,0,"FINAL CNT")),","),20)
  1.  S MSG(9)="Patient Count                   "_$J($FN(+$G(^TMP("SCDX MTU",$J,0,"PATNUM")),","),20)
  1.  ;
  1.  S XMSUB="MEANS TEST = 'U' REPORT STATISTICS"
  1.  S XMTEXT="MSG("
  1.  S XMY(DUZ)=""
  1.  S XMDUZ="ACRP MT=U STATS"
  1.  D ^XMD
  1.  Q
  1.  ;
  1. PRINT ; Print Report
  1.  ;SD*5.3*474 added SDFLAG and corresponding logic
  1.  N SDNAME,SDNODE,SDXNODE,SDOEI,SDOEX,SDOEDT,DFN,PRNTL4,VA,PAGE,SDFLAG
  1.  ;
  1.  S PAGE=0
  1.  D HDR
  1.  S SDNAME=""
  1.  F  S SDNAME=$O(^TMP("SCDX ASORT",$J,SDNAME)) Q:SDNAME']""  D
  1.  . W !,$E(SDNAME,1,30)
  1.  . S PRNTL4=0,SDFLAG=1
  1.  . S SDOEDT=0
  1.  . F  S SDOEDT=$O(^TMP("SCDX ASORT",$J,SDNAME,SDOEDT)) Q:'SDOEDT  D
  1.  . . S DFN=$P($G(^TMP("SCDX ASORT",$J,SDNAME,SDOEDT)),U,3)
  1.  . . S SDOEX=$P($G(^TMP("SCDX ASORT",$J,SDNAME,SDOEDT)),U,1)
  1.  . . S SDOEI=$P($G(^TMP("SCDX ASORT",$J,SDNAME,SDOEDT)),U,2)
  1.  . . I 'PRNTL4 D  S PRNTL4=1
  1.  . . . D PID^VADPT6
  1.  . . . W ?($L(SDNAME)+1),"(",VA("BID"),")"
  1.  . . I 'SDFLAG D  S SDFLAG=1
  1.  . . . W !,$E(SDNAME,1,30)
  1.  . . . D PID^VADPT6
  1.  . . . W ?($L(SDNAME)+1),"(",VA("BID"),")"
  1.  . . W ?35,$$FMTE^XLFDT(SDOEDT,"D"),$S(SDOEX>0:" *",1:"  ")
  1.  . . W ?56,$P($G(^TMP("SCDX ASORT",$J,SDNAME,SDOEDT)),U,4)
  1.  . . S SDNODE=$G(^SCE(SDOEI,0))
  1.  . . W ?68,$E($$GET1^DIQ(40.8,$P(SDNODE,U,11),.01),1,30)
  1.  . . W ?100,$E($$GET1^DIQ(44,$P(SDNODE,U,4),.01),1,30)
  1.  . . I ($Y+5)>IOSL D HDR S SDFLAG=0 Q
  1.  . . W !
  1.  D FTR1
  1.  Q
  1.  ;
  1. HDR ; Report Header
  1.  N SPACE,LINE,TAB,PRNTLN
  1.  ;
  1.  I PAGE>0 D FTR
  1.  W:PAGE>0 @IOF
  1.  S PAGE=PAGE+1
  1.  ;
  1.  S PRNTLN="Transmitted Outpatient Encounters with Means Test = 'U'"
  1.  S TAB=(IOM-$L(PRNTLN))\2
  1.  W !?TAB,PRNTLN
  1.  S PRNTLN="Date Range: "_$$FMTE^XLFDT(SDBEG)_" thru "_$$FMTE^XLFDT(SDEND)
  1.  S TAB=(IOM-$L(PRNTLN))\2
  1.  W !!?TAB,PRNTLN
  1.  S PRNTLN="Print Date: "_$$FMTE^XLFDT($$NOW^XLFDT)
  1.  S TAB=(IOM-$L(PRNTLN))\2
  1.  W !?TAB,PRNTLN
  1.  S PRNTLN="Page: "_PAGE
  1.  S TAB=(IOM-$L(PRNTLN))\2
  1.  W !?TAB,PRNTLN
  1.  ;
  1.  W !!?35,"Outpatient",?52,"",?68,"Medical Ctr"
  1.  W !,"PATIENT NAME",?35,"Encounter Date",?52,"MT Indicator",?68,"Division",?100,"Clinic"
  1.  ;
  1.  S $P(LINE,"=",IOM)="" W !,LINE
  1.  Q
  1.  ;
  1. FTR ; Report Footer
  1.  N SDX
  1.  ;
  1.  F SDX=$Y:1:IOSL-2 W !
  1.  W ?5,"* - Transmitted Outpatient Encounter"
  1.  Q
  1.  ;
  1. FTR1 ;
  1.  W !?5,"* - Transmitted Outpatient Encounter"
  1.  Q
  1.  ;