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

SDSCMSR.m

Go to the documentation of this file.
  1. SDSCMSR ;ALB/JAM/RBS - ASCD Managers Summary Data Report ; 3/5/07 11:44am
  1. ;;5.3;Scheduling;**495**;Aug 13, 1993;Build 50
  1. ;;MODIFIED FOR NATIONAL RELEASE from a Class III software product
  1. ;;known as Service Connected Automated Monitoring (SCAM).
  1. ;
  1. ;**Program Description**
  1. ; This report is to be used by managers only
  1. Q
  1. EN ; Entry Point
  1. N ZTQUEUED,POP,ZTRTN,ZTDTH,ZTDESC,ZTSAVE,SDSCDVSL,SDSCDVLN,WHO,DIR,X,Y
  1. N SDSCBDT
  1. K ^TMP("SDSCMGR",$J)
  1. ; Get Divisions
  1. D DIV^SDSCUTL
  1. D ^DIR
  1. I $G(DTOUT)!($G(DUOUT)) G EXIT
  1. S SDSCDVSL=Y,SDSCDVLN=SCLN
  1. ; Get start and end date for report
  1. S (SDSCBDT,SDSCEDT)=""
  1. S SDSCBDT=$O(^SCE("B",""))\1,SDSCEDT=DT
  1. D GETDATE1^SDSCOMP I SDSCTDT="" G EXIT
  1. K DIR,X,Y
  1. S DIR(0)="S^A:All Encounters;C:Compiled ASCD Encounters Only"
  1. S DIR("A")="Select to check ",DIR("B")="Compiled ASCD Encounters Only"
  1. D ^DIR
  1. I $G(DTOUT)!($G(DUOUT)) G EXIT
  1. S WHO=Y
  1. K %ZIS,IOP,IOC,ZTIO S %ZIS="MQ" D ^%ZIS G:POP EXIT
  1. I $D(IO("Q")) D G EXIT
  1. . S ZTRTN="BEG^SDSCMSR",ZTDTH=$H,ZTDESC="ASCD Manager Summary Report"
  1. . S ZTSAVE("WHO")="",ZTSAVE("SDSCBDT")="",ZTSAVE("SDSCEDT")="",ZTSAVE("SDSCDVSL")=""
  1. . S ZTSAVE("SDSCDVLN")="",ZTSAVE("SDEDT")="",ZTSAVE("SDSCTDT")=""
  1. . K IO("Q") D ^%ZTLOAD W !,"REQUEST QUEUED"
  1. ;
  1. BEG ; Begin report
  1. N DTOTAL,DATOTAL,CT,P,L,SDABRT,AJ,DTOT,SDSCDIV,SDSCDNM,THDR,AI
  1. S (DTOTAL,DATOTAL,CT)=0
  1. S (P,L,SDABRT)=0
  1. F AJ="VBA","NO CHANGE","SCNSC","NSCSC","REV","NOT","NPROC" S DTOT(AJ)=0
  1. S SDSCDIV=$S(SDSCDVSL'[SDSCDVLN:SDSCDVSL,1:"")
  1. I SDSCDIV="" S SDSCDNM="ALL" D BLD G EXT
  1. I SDSCDIV'="" D
  1. . S THDR=""
  1. . F AI=1:1:$L(SDSCDVSL,",") S SDSCDIV=$P(SDSCDVSL,",",AI) Q:SDSCDIV="" D Q:$G(SDABRT)=1
  1. .. S SDSCDNM=$P(^DG(40.8,SDSCDIV,0),"^",1),THDR=THDR_SDSCDNM_",",CT=CT+1 D BLD
  1. G EXT
  1. ;
  1. BLD ;
  1. N SDOEDT,ATOTAL,ENC,SDOE0,TOTAL,EDIV,SDEFLG,SI,SUBTOT,SDNWPV,DIV
  1. N SBTOT,SDOE,SDSCDATA,SCVAL
  1. I WHO="A" S SDOEDT=SDSCTDT,ATOTAL=0 D
  1. . I '$D(ZTQUEUED) D EN^DDIOL("Please wait while I count encounters")
  1. . F S SDOEDT=$O(^SCE("B",SDOEDT)) Q:SDOEDT\1>SDEDT!(SDOEDT="") D
  1. .. S ENC="" F S ENC=$O(^SCE("B",SDOEDT,ENC)) Q:ENC="" D
  1. ... S SDOE0=$$GETOE^SDOE(ENC,0)
  1. ... I SDSCDIV'="" Q:$P(SDOE0,U,11)'=SDSCDIV
  1. ... I $P(SDOE0,U,12)=2 S ATOTAL=ATOTAL+1 I '$D(ZTQUEUED) W:ATOTAL#100=0 "."
  1. ;
  1. FND ;
  1. S SDOEDT=SDSCTDT,TOTAL=0
  1. F S SDOEDT=$O(^SDSC(409.48,"AE",SDOEDT)) Q:SDOEDT\1>SDEDT!(SDOEDT="") D
  1. . S SDOE=""
  1. . F S SDOE=$O(^SDSC(409.48,"AE",SDOEDT,SDOE)) Q:SDOE="" D
  1. .. I SDSCDIV'="" Q:$P(^SDSC(409.48,SDOE,0),U,12)'=SDSCDIV
  1. .. S EDIV=$P(^SDSC(409.48,SDOE,0),U,12),TOTAL=TOTAL+1
  1. .. ; if division is null, check for value
  1. .. I EDIV="" D
  1. ... S EDIV=$P($G(^SCE(SDOE,0)),U,11)
  1. ... I EDIV="" S EDIV="~" Q
  1. ... D UPD(SDOE,.12,EDIV,"I")
  1. .. ; Check for not editable
  1. .. S SDEFLG=0 D CHECK^SDSCEDT
  1. .. I 'SDEFLG D STORE("NOT") W "!X" Q
  1. .. S SDSCDATA=$G(^SDSC(409.48,SDOE,0)) I SDSCDATA="" Q
  1. .. I +$P(SDSCDATA,U,9),+$P(SDSCDATA,U,6) D STORE("VBA") Q
  1. .. I $P(SDSCDATA,U,5)="R" D STORE("REV") Q
  1. .. I $P(SDSCDATA,U,5)="C" S SCVAL=$$SCHNG^SDSCUTL(SDOE) D:SCVAL'=""
  1. ...I '+SCVAL D STORE("NO CHANGE") Q
  1. ...I $P(SCVAL,"^",2) D STORE("SCNSC") Q
  1. ...D STORE("NSCSC")
  1. ;
  1. PRT ; Print report
  1. S SUBTOT=0
  1. S SDHDR="Managers Summary Data Report"
  1. U IO D STDHDR^SDSCRPT2 Q:$G(SDABRT)=1
  1. S SDNWPV=1
  1. W SDHDR,?67,"PAGE: ",P
  1. W !,?5,"For Encounters Dated ",$$FMTE^XLFDT(SDSCTDT,2)," THRU ",$$FMTE^XLFDT(SDEDT,2)," For Division: ",SDSCDNM,!!
  1. W ! F I=1:1:79 W "-"
  1. ;
  1. I WHO="A" W !,"All Checked Out Encounters: ",?52,$J(ATOTAL,10) S DATOTAL=DATOTAL+ATOTAL
  1. W !,"ASCD Encounters that are potentially billable: ",?55,$J(TOTAL,7) S DTOTAL=DTOTAL+TOTAL
  1. W !,?55,$J("-------",7)
  1. S SBTOT=0,DIV="" F S DIV=$O(^TMP("SDSCMGR",$J,"VBA",DIV)) Q:DIV="" D
  1. . S SBTOT=SBTOT+^TMP("SDSCMGR",$J,"VBA",DIV)
  1. W !,"Encounters verified with Rated Disability Codes: ",?55,$J(SBTOT,7) S SUBTOT=SUBTOT+SBTOT,DTOT("VBA")=DTOT("VBA")+SBTOT
  1. S SBTOT=0,DIV="" F S DIV=$O(^TMP("SDSCMGR",$J,"NO CHANGE",DIV)) Q:DIV="" D
  1. . S SBTOT=SBTOT+^TMP("SDSCMGR",$J,"NO CHANGE",DIV)
  1. W !,"Encounters where SC NOT changed: ",?55,$J(SBTOT,7) S SUBTOT=SUBTOT+SBTOT,DTOT("NO CHANGE")=DTOT("NO CHANGE")+SBTOT
  1. S SBTOT=0,DIV="" F S DIV=$O(^TMP("SDSCMGR",$J,"SCNSC",DIV)) Q:DIV="" D
  1. . S SBTOT=SBTOT+^TMP("SDSCMGR",$J,"SCNSC",DIV)
  1. W !,"Encounters where SC was changed to NSC: ",?55,$J(SBTOT,7) S SUBTOT=SUBTOT+SBTOT,DTOT("SCNSC")=DTOT("SCNSC")+SBTOT
  1. S SBTOT=0,DIV="" F S DIV=$O(^TMP("SDSCMGR",$J,"NSCSC",DIV)) Q:DIV="" D
  1. . S SBTOT=SBTOT+^TMP("SDSCMGR",$J,"NSCSC",DIV)
  1. W !,"Encounters where NSC was changed to SC: ",?55,$J(SBTOT,7) S SUBTOT=SUBTOT+SBTOT,DTOT("NSCSC")=DTOT("NSCSC")+SBTOT
  1. S SBTOT=0,DIV="" F S DIV=$O(^TMP("SDSCMGR",$J,"REV",DIV)) Q:DIV="" D
  1. . S SBTOT=SBTOT+^TMP("SDSCMGR",$J,"REV",DIV)
  1. W !,"Encounters sent to Clinical Review: ",?55,$J(SBTOT,7) S SUBTOT=SUBTOT+SBTOT,DTOT("REV")=DTOT("REV")+SBTOT
  1. S SBTOT=0,DIV="" F S DIV=$O(^TMP("SDSCMGR",$J,"NOT",DIV)) Q:DIV="" D
  1. . S SBTOT=SBTOT+^TMP("SDSCMGR",$J,"NOT",DIV)
  1. W !,"Encounters not editable: ",?55,$J(SBTOT,7) S SUBTOT=SUBTOT+SBTOT,DTOT("NOT")=DTOT("NOT")+SBTOT
  1. W !,"Encounters not yet processed: ",?55,$J(TOTAL-SUBTOT,7) S DTOT("NPROC")=DTOT("NPROC")+(TOTAL-SUBTOT)
  1. W !!!
  1. K ^TMP("SDSCMGR",$J)
  1. Q
  1. ;
  1. UPD(SDENC,SDFLD,SDVAL,SDFLG) ; Update record
  1. N SDPD
  1. S SDPD(409.48,SDENC_",",SDFLD)=SDVAL
  1. D FILE^DIE(SDFLG,"SDPD","ERROR")
  1. Q
  1. EXT ;
  1. I CT>1,$G(SDABRT)'=1 D PRTT
  1. D RPTEND^SDSCRPT1
  1. ;
  1. EXIT ;
  1. K SDTYPE,SDSCTDT,SDEDT,SDSCEDT,SCLN,DIRUT,DTOUT,DUOUT,SDHDR
  1. K SDSCMSG,SDFLG,SDOEDAT,SDOSC,SDPAT,SDSCPKG,SDSCSRC,SDV0
  1. Q
  1. STORE(VAL) ; Total up and Store
  1. S ^TMP("SDSCMGR",$J,VAL,EDIV)=$G(^TMP("SDSCMGR",$J,VAL,EDIV))+1
  1. S ^TMP("SDSCMGR",$J,VAL,EDIV,SDOE)=""
  1. K VAL
  1. Q
  1. ;
  1. PRTT ; Print total page
  1. N HHDR,HHDR1,HHDR2,HHDR3,HHDR4,I
  1. U IO D STDHDR^SDSCRPT2 Q:$G(SDABRT)=1
  1. I $E(THDR,$L(THDR))="," S THDR=$E(THDR,1,$L(THDR)-1)
  1. W SDHDR,?67,"PAGE: ",P
  1. S HHDR1="For Encounters Dated "_$$FMTE^XLFDT(SDSCTDT,2)_" THRU "_$$FMTE^XLFDT(SDEDT,2)_" TOTAL for "
  1. S HHDR2=THDR
  1. I $L(HHDR1)+$L(HHDR2)>IOM D
  1. . S HHDR3=$P(HHDR2,",",1),HHDR4=$P(HHDR2,",",2,99)
  1. . S HHDR=HHDR1_HHDR3
  1. . I HHDR4'="" S HHDR=HHDR_","
  1. I $L(HHDR1)+$L(HHDR2)'>IOM D
  1. . S HHDR=HHDR1_HHDR2
  1. W !,HHDR
  1. I $G(HHDR4)'="" W !,?5,HHDR4
  1. W ! F I=1:1:79 W "-"
  1. ;
  1. I WHO="A" W !,"All Checked Out Encounters: ",?52,$J(DATOTAL,10)
  1. W !,"ASCD Encounters w/ SC='Yes' & potentially billable: ",?55,$J(DTOTAL,7)
  1. W !,?55,$J("-------",7)
  1. W !,"Encounters verified with Rated Disability Codes: ",?55,$J(DTOT("VBA"),7)
  1. W !,"Encounters where SC NOT changed: ",?55,$J(DTOT("NO CHANGE"),7)
  1. W !,"Encounters where SC was changed to NSC: ",?55,$J(DTOT("SCNSC"),7)
  1. W !,"Encounters where NSC was changed to SC: ",?55,$J(DTOT("NSCSC"),7)
  1. W !,"Encounters sent to Clinical Review: ",?55,$J(DTOT("REV"),7)
  1. W !,"Encounters not editable: ",?55,$J(DTOT("NOT"),7)
  1. W !,"Encounters not yet processed: ",?55,$J(DTOT("NPROC"),7)
  1. W !!!
  1. Q