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

SDSCSSD.m

Go to the documentation of this file.
  1. SDSCSSD ;ALB/JAM/RBS - ASCD Service Summary Data Report ; 3/13/07 12:30pm
  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 DIR,X,Y,SDSCRVNM,SDSCSRV,ZTQUEUED,POP,ZTRTN,ZTDTH,ZTDESC,ZTSAVE
  1. K ^TMP("SDSCSRV",$J)
  1. ; Get start and end date for report
  1. D GETDATE^SDSCOMP I SDSCTDT="" G EXIT
  1. ; Get Service
  1. D SRV^SDSCUTL S DIR("B")="ALL"
  1. D ^DIR
  1. I $G(DTOUT)!($G(DUOUT)) G EXIT
  1. S SDSCRVNM=Y(0)
  1. S SDSCSRV=$S(Y'="A":Y,1:"")
  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="FND^SDSCSSD",ZTDTH=$H,ZTDESC="ASCD Service Summary Report"
  1. . S ZTSAVE("SDSCBDT")="",ZTSAVE("SDSCEDT")="",ZTSAVE("SDSCRVNM")=""
  1. . S ZTSAVE("SDSCSRV")="",ZTSAVE("SDEDT")="",ZTSAVE("SDSCTDT")=""
  1. . K IO("Q") D ^%ZTLOAD W !,"REQUEST QUEUED"
  1. ;
  1. FND ;
  1. N SDOEDT,TOTAL,SDOE,CLIN,CLNM,SERV,SDSCDATA,SI,SDABRT,VAL,AMT,COL,P,L
  1. N SBTOT,TYP,SCVAL
  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. .. S CLIN=$$GET1^DIQ(409.68,SDOE_",",.04,"I") I CLIN="" Q
  1. .. S CLNM=$$GET1^DIQ(409.68,SDOE_",",.04,"E")
  1. .. I SDSCSRV'="" Q:$$GET1^DIQ(44,CLIN_",",9,"I")'=SDSCSRV
  1. .. S SERV=$$GET1^DIQ(44,CLIN_",",9,"E")
  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'="" Q
  1. ...I '+SCVAL D STORE("NO CHANGE") Q
  1. ...I $P(SCVAL,"^",2) D STORE("SCNSC") Q
  1. ...D STORE("NSCSC")
  1. .. D STORE("NEW")
  1. ;
  1. PRT ; Print report
  1. S (P,L,SDABRT)=0 D HDR G EXT:$G(SDABRT)=1
  1. F VAL="VBA","REV","NO CHANGE","SCNSC","NSCSC","NEW" S TOTAL(VAL)=0
  1. S SERV="" F S SERV=$O(^TMP("SDSCSRV",$J,SERV)) Q:SERV="" D Q:$G(SDABRT)=1
  1. . I L+4>IOSL D HDR Q:$G(SDABRT)=1
  1. . W !,SERV S L=L+1 F VAL="VBA","REV","NO CHANGE","SCNSC","NSCSC","NEW" S SBTOT(VAL)=0
  1. . S CLNM="" F S CLNM=$O(^TMP("SDSCSRV",$J,SERV,CLNM)) Q:CLNM="" D Q:$G(SDABRT)=1
  1. .. I L+4>IOSL D HDR Q:$G(SDABRT)=1
  1. .. W !,?1,$E(CLNM,1,20) S COL=21,L=L+1
  1. .. F VAL="VBA","REV","SCNSC","NSCSC","NO CHANGE","NEW" D
  1. ... S AMT=+$G(^TMP("SDSCSRV",$J,SERV,CLNM,VAL)) W ?COL,$J(AMT,7) S COL=COL+10
  1. ... S SBTOT(VAL)=SBTOT(VAL)+AMT,TOTAL(VAL)=$G(TOTAL(VAL))+AMT
  1. . Q:$G(SDABRT)=1
  1. . I L+4>IOSL D HDR Q:$G(SDABRT)=1
  1. . W ! S COL=21,L=L+1 F VAL="VBA","REV","SCNSC","NSCSC","NO CHANGE","NEW" D
  1. .. W ?COL,"---------" S COL=COL+10
  1. . I L+4>IOSL D HDR Q:$G(SDABRT)=1
  1. . W !,"Subtotal "_SERV
  1. . S COL=21,L=L+1 F VAL="VBA","REV","SCNSC","NSCSC","NO CHANGE","NEW" D
  1. .. W ?COL,$J(SBTOT(VAL),7) S COL=COL+10
  1. I $G(SDABRT)=1 G EXT
  1. I L+4>IOSL D HDR Q:$G(SDABRT)=1
  1. S COL=21,L=L+1 W !
  1. F TYP="VBA","REV","SCNSC","NSCSC","NO CHANGE","NEW" D
  1. . W ?COL,"---------" S COL=COL+10
  1. S COL=21,L=L+1 W !,"TOTAL"
  1. F TYP="VBA","REV","SCNSC","NSCSC","NO CHANGE","NEW" D
  1. . W ?COL,$J($G(TOTAL(TYP)),7) S COL=COL+10
  1. EXT ;
  1. D RPTEND^SDSCRPT1
  1. ;
  1. EXIT ;
  1. K SDSCTDT,SDEDT,DIR,Y,SDSCRVNM,SDSCBDT,SDSCEDT,SDSCMSG,SDEFLG
  1. K SDFLG,SDOEDAT,SDOSC,SDPAT,SDSCPKG,SDSCSRC,SDV0,I,DIV,SDABRT
  1. K SDSCSRV,SDSCDNM,SUBTOT,X,DIRUT,DTOUT,DUOUT ;^TMP("SDSCSRV",$J)
  1. Q
  1. STORE(VAL) ; Total up and Store
  1. S ^TMP("SDSCSRV",$J,SERV,CLNM,VAL)=$G(^TMP("SDSCSRV",$J,SERV,CLNM,VAL))+1
  1. S ^TMP("SDSCSRV",$J,SERV,CLNM,VAL,SDOE)=""
  1. K VAL
  1. Q
  1. HDR ; Header
  1. N SDHDR,SDNWPV,I
  1. S SDHDR="Service Summary Data Report"
  1. U IO D STDHDR^SDSCRPT2 Q:$G(SDABRT)=1
  1. S SDNWPV=1,L=4
  1. W SDHDR,?67,"PAGE: ",P
  1. W !,?5,"For Encounters Dated ",$$FMTE^XLFDT(SDSCTDT,2)," THRU ",$$FMTE^XLFDT(SDEDT,2)," For Service: ",SDSCRVNM
  1. W !?24,"VBA OK",?34,"REVIEW",?43,"SC to NSC",?53,"NSC to SC",?65,"SC KEPT",?75,"NEW"
  1. W ! F I=1:1:79 W "-"
  1. Q