source: FOIAVistA/tag/r/SCHEDULING-SD-SC/SDSCSSD.m@ 1423

SDSCSSD ;ALB/JAM/RBS - ASCD Service Summary Data Report ; 3/13/07 12:30pm
 ;;5.3;Scheduling;**495**;Aug 13, 1993;Build 50
 ;;MODIFIED FOR NATIONAL RELEASE from a Class III software product
 ;;known as Service Connected Automated Monitoring (SCAM).
 ;
 ;**Program Description**
 ;  This report is to be used by managers only
 Q
EN ;  Entry Point
 N DIR,X,Y,SDSCRVNM,SDSCSRV,ZTQUEUED,POP,ZTRTN,ZTDTH,ZTDESC,ZTSAVE
 K ^TMP("SDSCSRV",$J)
 ;  Get start and end date for report
 D GETDATE^SDSCOMP I SDSCTDT="" G EXIT
 ; Get Service
 D SRV^SDSCUTL S DIR("B")="ALL"
 D ^DIR
 I $G(DTOUT)!($G(DUOUT)) G EXIT
 S SDSCRVNM=Y(0)
 S SDSCSRV=$S(Y'="A":Y,1:"")
 K %ZIS,IOP,IOC,ZTIO S %ZIS="MQ" D ^%ZIS G:POP EXIT
 I $D(IO("Q")) D  G EXIT
 . S ZTRTN="FND^SDSCSSD",ZTDTH=$H,ZTDESC="ASCD Service Summary Report"
 . S ZTSAVE("SDSCBDT")="",ZTSAVE("SDSCEDT")="",ZTSAVE("SDSCRVNM")=""
 . S ZTSAVE("SDSCSRV")="",ZTSAVE("SDEDT")="",ZTSAVE("SDSCTDT")=""
 . K IO("Q") D ^%ZTLOAD W !,"REQUEST QUEUED"
 ;
FND ;
 N SDOEDT,TOTAL,SDOE,CLIN,CLNM,SERV,SDSCDATA,SI,SDABRT,VAL,AMT,COL,P,L
 N SBTOT,TYP,SCVAL
 S SDOEDT=SDSCTDT,TOTAL=0
 F  S SDOEDT=$O(^SDSC(409.48,"AE",SDOEDT)) Q:SDOEDT\1>SDEDT!(SDOEDT="")  D
 . S SDOE=""
 . F  S SDOE=$O(^SDSC(409.48,"AE",SDOEDT,SDOE)) Q:SDOE=""  D
 .. S CLIN=$$GET1^DIQ(409.68,SDOE_",",.04,"I") I CLIN="" Q
 .. S CLNM=$$GET1^DIQ(409.68,SDOE_",",.04,"E")
 .. I SDSCSRV'="" Q:$$GET1^DIQ(44,CLIN_",",9,"I")'=SDSCSRV
 .. S SERV=$$GET1^DIQ(44,CLIN_",",9,"E")
 .. S SDSCDATA=$G(^SDSC(409.48,SDOE,0)) I SDSCDATA="" Q
 .. I +$P(SDSCDATA,U,9),+$P(SDSCDATA,U,6) D STORE("VBA") Q
 .. I $P(SDSCDATA,U,5)="R" D STORE("REV") Q
 .. I $P(SDSCDATA,U,5)="C" S SCVAL=$$SCHNG^SDSCUTL(SDOE) D:SCVAL'=""  Q
 ...I '+SCVAL D STORE("NO CHANGE") Q
 ...I $P(SCVAL,"^",2) D STORE("SCNSC") Q
 ...D STORE("NSCSC")
 .. D STORE("NEW")
 ;
PRT ;  Print report
 S (P,L,SDABRT)=0 D HDR G EXT:$G(SDABRT)=1
 F VAL="VBA","REV","NO CHANGE","SCNSC","NSCSC","NEW" S TOTAL(VAL)=0
 S SERV="" F  S SERV=$O(^TMP("SDSCSRV",$J,SERV)) Q:SERV=""  D  Q:$G(SDABRT)=1
 . I L+4>IOSL D HDR Q:$G(SDABRT)=1
 . W !,SERV S L=L+1 F VAL="VBA","REV","NO CHANGE","SCNSC","NSCSC","NEW" S SBTOT(VAL)=0
 . S CLNM="" F  S CLNM=$O(^TMP("SDSCSRV",$J,SERV,CLNM)) Q:CLNM=""  D  Q:$G(SDABRT)=1
 .. I L+4>IOSL D HDR Q:$G(SDABRT)=1
 .. W !,?1,$E(CLNM,1,20) S COL=21,L=L+1
 .. F VAL="VBA","REV","SCNSC","NSCSC","NO CHANGE","NEW" D
 ... S AMT=+$G(^TMP("SDSCSRV",$J,SERV,CLNM,VAL)) W ?COL,$J(AMT,7) S COL=COL+10
 ... S SBTOT(VAL)=SBTOT(VAL)+AMT,TOTAL(VAL)=$G(TOTAL(VAL))+AMT
 . Q:$G(SDABRT)=1
 . I L+4>IOSL D HDR Q:$G(SDABRT)=1
 . W ! S COL=21,L=L+1 F VAL="VBA","REV","SCNSC","NSCSC","NO CHANGE","NEW" D
 .. W ?COL,"---------" S COL=COL+10
 . I L+4>IOSL D HDR Q:$G(SDABRT)=1
 . W !,"Subtotal "_SERV
 . S COL=21,L=L+1 F VAL="VBA","REV","SCNSC","NSCSC","NO CHANGE","NEW" D
 .. W ?COL,$J(SBTOT(VAL),7) S COL=COL+10
 I $G(SDABRT)=1 G EXT
 I L+4>IOSL D HDR Q:$G(SDABRT)=1
 S COL=21,L=L+1 W !
 F TYP="VBA","REV","SCNSC","NSCSC","NO CHANGE","NEW" D
 . W ?COL,"---------"  S COL=COL+10
 S COL=21,L=L+1 W !,"TOTAL"
 F TYP="VBA","REV","SCNSC","NSCSC","NO CHANGE","NEW" D
 . W ?COL,$J($G(TOTAL(TYP)),7) S COL=COL+10
EXT ;
 D RPTEND^SDSCRPT1
 ;
EXIT ;
 K SDSCTDT,SDEDT,DIR,Y,SDSCRVNM,SDSCBDT,SDSCEDT,SDSCMSG,SDEFLG
 K SDFLG,SDOEDAT,SDOSC,SDPAT,SDSCPKG,SDSCSRC,SDV0,I,DIV,SDABRT
 K SDSCSRV,SDSCDNM,SUBTOT,X,DIRUT,DTOUT,DUOUT ;^TMP("SDSCSRV",$J)
 Q
STORE(VAL) ; Total up and Store
 S ^TMP("SDSCSRV",$J,SERV,CLNM,VAL)=$G(^TMP("SDSCSRV",$J,SERV,CLNM,VAL))+1
 S ^TMP("SDSCSRV",$J,SERV,CLNM,VAL,SDOE)=""
 K VAL
 Q
HDR ;  Header
 N SDHDR,SDNWPV,I
 S SDHDR="Service Summary Data Report"
 U IO D STDHDR^SDSCRPT2 Q:$G(SDABRT)=1
 S SDNWPV=1,L=4
 W SDHDR,?67,"PAGE: ",P
 W !,?5,"For Encounters Dated ",$$FMTE^XLFDT(SDSCTDT,2)," THRU ",$$FMTE^XLFDT(SDEDT,2)," For Service: ",SDSCRVNM
 W !?24,"VBA OK",?34,"REVIEW",?43,"SC to NSC",?53,"NSC to SC",?65,"SC KEPT",?75,"NEW"
 W ! F I=1:1:79 W "-"
 Q