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