98 lines
3.8 KiB
Mathematica
98 lines
3.8 KiB
Mathematica
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
|