- 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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDSCSSD 3988 printed Feb 19, 2025@00:27:52 Page 2
- SDSCSSD ;ALB/JAM/RBS - ASCD Service Summary Data Report ; 3/13/07 12:30pm
- +1 ;;5.3;Scheduling;**495**;Aug 13, 1993;Build 50
- +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