- SDSCUSR ;ALB/JAM/RBS - ASCD User Total Report ; 1/19/07 1:28pm
- ;;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 gives a total of the number of encounters that meet
- ; the criteria: SC='Yes', auto-verified, and changed
- Q
- EN ; Entry Point
- N DIR,X,Y,SDSCDVSL,SDSCDVLN,ZTQUEUED,POP,ZTRTN,ZTDTH,ZTDESC,ZTSAVE
- ; Get start and end date for report
- D GETDATE^SDSCOMP I SDSCTDT="" G EXIT
- ; Get Divisions
- D DIV^SDSCUTL
- D ^DIR
- I $G(DTOUT)!($G(DUOUT)) G EXIT
- S SDSCDVSL=Y,SDSCDVLN=SCLN
- K %ZIS,IOP,IOC,ZTIO S %ZIS="MQ" D ^%ZIS G:POP EXIT
- I $D(IO("Q")) D G EXIT
- . S ZTRTN="BEG^SDSCUSR",ZTDTH=$H,ZTDESC="ASCD User Total Report"
- . S ZTSAVE("SDSCBDT")="",ZTSAVE("SDSCEDT")="",ZTSAVE("SDSCDVSL")=""
- . S ZTSAVE("SDSCDVLN")="",ZTSAVE("GROUP")="",ZTSAVE("SDEDT")="",ZTSAVE("SDSCTDT")=""
- . K IO("Q") D ^%ZTLOAD W !,"REQUEST QUEUED"
- ;
- BEG ; Begin report
- N P,L,SDABRT,CT,SDSCDIV,SDSCDNM,THDR,SDI
- S (P,L,SDABRT,CT)=0
- S SDSCDIV=$S(SDSCDVSL'[SDSCDVLN:SDSCDVSL,1:"")
- I SDSCDIV="" S SDSCDNM="ALL" D FND G EXT
- I SDSCDIV'="" D
- . S THDR=""
- . F SDI=1:1:$L(SDSCDVSL,",") S SDSCDIV=$P(SDSCDVSL,",",SDI) Q:SDSCDIV="" D Q:$G(SDABRT)=1
- .. S SDSCDNM=$P(^DG(40.8,SDSCDIV,0),"^",1),THDR=THDR_SDSCDNM_",",CT=CT+1 D FND
- G EXT
- ;
- FND ;
- N SDORG,SDOEDT,SDOE,EDNM,SDSCDATA,UIEN,UNAME,TYP,TOTAL,LEV1,COL,AMT
- K ^TMP("SDSCUSR",$J)
- S SDOEDT=SDSCTDT
- 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
- .. I SDSCDIV'="" Q:$P(^SDSC(409.48,SDOE,0),U,12)'=SDSCDIV
- .. S EDNM=0,SDORG=$P($$SCHNG^SDSCUTL(SDOE),U,2)
- .. F S EDNM=$O(^SDSC(409.48,SDOE,1,EDNM)) Q:'EDNM D
- ... S SDSCDATA=^SDSC(409.48,SDOE,1,EDNM,0),UNAME=""
- ... S UIEN=$P(SDSCDATA,U,3) I UIEN'="" S UNAME=$$UP^XLFSTR($$NAME^XUSER(UIEN,"F"))
- ... I $P(SDSCDATA,U,6)=1 D STORE("REVIEW")
- ... I $P(SDSCDATA,U,5)=SDORG D STORE("NO CHANGE") Q
- ... I SDORG,$P(SDSCDATA,U,5)=0 D STORE("SCNSC") Q
- ... I 'SDORG,$P(SDSCDATA,U,5) D STORE("NSCSC")
- ;
- PRT ; Print
- K TOTAL
- S SDHDR="User Summary Data Report"
- D HDR Q:$G(SDABRT)=1
- F TYP="REVIEW","SCNSC","NSCSC","NO CHANGE" S TOTAL(TYP)=0
- S LEV1=""
- F S LEV1=$O(^TMP("SDSCUSR",$J,LEV1)) Q:LEV1="" D Q:$G(SDABRT)=1
- . I L+4>IOSL D HDR Q:$G(SDABRT)=1
- . W !,LEV1 S L=L+1
- . S COL=30 F TYP="REVIEW","SCNSC","NSCSC","NO CHANGE" S COL=COL+10 D
- .. S AMT=+$G(^TMP("SDSCUSR",$J,LEV1,TYP)),DTOT(LEV1,TYP)=$G(DTOT(LEV1,TYP))+AMT,TOTAL(TYP)=$G(TOTAL(TYP))+AMT
- .. W ?COL,$J(AMT,7)
- I $G(SDABRT)=1 Q
- S COL=30,L=L+1 W ! I L+4>IOSL D HDR Q:$G(SDABRT)=1
- F TYP="REVIEW","SCNSC","NSCSC","NO CHANGE" S COL=COL+10 D
- . W ?COL,"-------"
- S COL=30,L=L+1 W !,"TOTAL"
- F TYP="REVIEW","SCNSC","NSCSC","NO CHANGE" S COL=COL+10 D
- . W ?COL,$J($G(TOTAL(TYP)),7)
- Q
- ;
- EXT ;
- I CT>1,$G(SDABRT)'=1 D PRTT
- D RPTEND^SDSCRPT1
- ;
- EXIT ;
- K SDNWPV,SDPVCN,SDSCBDT,SDSCEDT,SDSCDATA,SDSCDIV,SDSCDNM,DIV,EDIV,TOTAL
- K SDHDR,SDSCTDT,SDEDT,I,L,P,SUBTOT,Y,POP,GROUP,SCLN,DTOUT,DUOUT,DTOT
- K ^TMP("SDSCUSR",$J) K LEV1,TYP
- Q
- ;
- STORE(VAL) ; Total up and Store
- S ^TMP("SDSCUSR",$J,UNAME,VAL)=$G(^TMP("SDSCUSR",$J,UNAME,VAL))+1
- S ^TMP("SDSCUSR",$J,UNAME,VAL,SDOE)=""
- K VAL
- Q
- ;
- HDR ; Header
- U IO D STDHDR^SDSCRPT2 Q:$G(SDABRT)=1
- S SDNWPV=1
- W SDHDR,?67,"PAGE: ",P
- W !,?5,"For Encounters Dated ",$$FMTE^XLFDT(SDSCTDT,2)," THRU ",$$FMTE^XLFDT(SDEDT,2)_" By Division: "_SDSCDNM
- W !?35,"SET to REVIEW",?50,"SC to NSC",?61,"NSC to SC",?72,"SC KEPT",!
- F I=1:1:79 W "-"
- Q
- ;
- HDR1 ;
- N HHDR,HHDR1,HHDR2,HHDR3,HHDR4,I
- U IO D STDHDR^SDSCRPT2 Q:$G(SDABRT)=1
- I $E(THDR,$L(THDR))="," S THDR=$E(THDR,1,$L(THDR)-1)
- W SDHDR,?67,"PAGE: ",P
- S HHDR1="For Encounters Dated "_$$FMTE^XLFDT(SDSCTDT,2)_" THRU "_$$FMTE^XLFDT(SDEDT,2)_" TOTAL for "
- S HHDR2=THDR
- I $L(HHDR1)+$L(HHDR2)>IOM D
- . S HHDR3=$P(HHDR2,",",1),HHDR4=$P(HHDR2,",",2,99)
- . S HHDR=HHDR1_HHDR3
- . I HHDR4'="" S HHDR=HHDR_","
- I $L(HHDR1)+$L(HHDR2)'>IOM D
- . S HHDR=HHDR1_HHDR2
- W !,HHDR
- I $G(HHDR4)'="" W !,?5,HHDR4
- W !?40," REVIEW",?50,"SC CHNG",?60,"SC KEPT",!
- F I=1:1:79 W "-"
- Q
- ;
- PRTT ;
- D HDR1 Q:$G(SDABRT)=1
- F TYP="REVIEW","SCNSC","NSCSC","NO CHANGE" S TOTAL(TYP)=0
- S LEV1=""
- F S LEV1=$O(DTOT(LEV1)) Q:LEV1="" D
- . I L+4>IOSL D HDR1 Q:$G(SDABRT)=1
- . W !,LEV1 S L=L+1
- . S COL=30 F TYP="REVIEW","SCNSC","NSCSC","NO CHANGE" S COL=COL+10 D
- .. S AMT=DTOT(LEV1,TYP),TOTAL(TYP)=$G(TOTAL(TYP))+AMT
- .. W ?COL,$J(AMT,7)
- S COL=30,L=L+1 W ! I L+4>IOSL D HDR1 Q:$G(SDABRT)=1
- F TYP="REVIEW","SCNSC","NSCSC","NO CHANGE" S COL=COL+10 D
- . W ?COL,"-------"
- S COL=30,L=L+1 W !,"TOTAL"
- F TYP="REVIEW","SCNSC","NSCSC","NO CHANGE" S COL=COL+10 D
- . W ?COL,$J($G(TOTAL(TYP)),7)
- Q
- SDSCUSR ;ALB/JAM/RBS - ASCD User Total Report ; 1/19/07 1:28pm
- +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 gives a total of the number of encounters that meet
- +7 ; the criteria: SC='Yes', auto-verified, and changed
- +8 QUIT
- EN ; Entry Point
- +1 NEW DIR,X,Y,SDSCDVSL,SDSCDVLN,ZTQUEUED,POP,ZTRTN,ZTDTH,ZTDESC,ZTSAVE
- +2 ; Get start and end date for report
- +3 DO GETDATE^SDSCOMP
- IF SDSCTDT=""
- GOTO EXIT
- +4 ; Get Divisions
- +5 DO DIV^SDSCUTL
- +6 DO ^DIR
- +7 IF $GET(DTOUT)!($GET(DUOUT))
- GOTO EXIT
- +8 SET SDSCDVSL=Y
- SET SDSCDVLN=SCLN
- +9 KILL %ZIS,IOP,IOC,ZTIO
- SET %ZIS="MQ"
- DO ^%ZIS
- IF POP
- GOTO EXIT
- +10 IF $DATA(IO("Q"))
- Begin DoDot:1
- +11 SET ZTRTN="BEG^SDSCUSR"
- SET ZTDTH=$HOROLOG
- SET ZTDESC="ASCD User Total Report"
- +12 SET ZTSAVE("SDSCBDT")=""
- SET ZTSAVE("SDSCEDT")=""
- SET ZTSAVE("SDSCDVSL")=""
- +13 SET ZTSAVE("SDSCDVLN")=""
- SET ZTSAVE("GROUP")=""
- SET ZTSAVE("SDEDT")=""
- SET ZTSAVE("SDSCTDT")=""
- +14 KILL IO("Q")
- DO ^%ZTLOAD
- WRITE !,"REQUEST QUEUED"
- End DoDot:1
- GOTO EXIT
- +15 ;
- BEG ; Begin report
- +1 NEW P,L,SDABRT,CT,SDSCDIV,SDSCDNM,THDR,SDI
- +2 SET (P,L,SDABRT,CT)=0
- +3 SET SDSCDIV=$SELECT(SDSCDVSL'[SDSCDVLN:SDSCDVSL,1:"")
- +4 IF SDSCDIV=""
- SET SDSCDNM="ALL"
- DO FND
- GOTO EXT
- +5 IF SDSCDIV'=""
- Begin DoDot:1
- +6 SET THDR=""
- +7 FOR SDI=1:1:$LENGTH(SDSCDVSL,",")
- SET SDSCDIV=$PIECE(SDSCDVSL,",",SDI)
- IF SDSCDIV=""
- QUIT
- Begin DoDot:2
- +8 SET SDSCDNM=$PIECE(^DG(40.8,SDSCDIV,0),"^",1)
- SET THDR=THDR_SDSCDNM_","
- SET CT=CT+1
- DO FND
- End DoDot:2
- IF $GET(SDABRT)=1
- QUIT
- End DoDot:1
- +9 GOTO EXT
- +10 ;
- FND ;
- +1 NEW SDORG,SDOEDT,SDOE,EDNM,SDSCDATA,UIEN,UNAME,TYP,TOTAL,LEV1,COL,AMT
- +2 KILL ^TMP("SDSCUSR",$JOB)
- +3 SET SDOEDT=SDSCTDT
- +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 IF SDSCDIV'=""
- IF $PIECE(^SDSC(409.48,SDOE,0),U,12)'=SDSCDIV
- QUIT
- +8 SET EDNM=0
- SET SDORG=$PIECE($$SCHNG^SDSCUTL(SDOE),U,2)
- +9 FOR
- SET EDNM=$ORDER(^SDSC(409.48,SDOE,1,EDNM))
- IF 'EDNM
- QUIT
- Begin DoDot:3
- +10 SET SDSCDATA=^SDSC(409.48,SDOE,1,EDNM,0)
- SET UNAME=""
- +11 SET UIEN=$PIECE(SDSCDATA,U,3)
- IF UIEN'=""
- SET UNAME=$$UP^XLFSTR($$NAME^XUSER(UIEN,"F"))
- +12 IF $PIECE(SDSCDATA,U,6)=1
- DO STORE("REVIEW")
- +13 IF $PIECE(SDSCDATA,U,5)=SDORG
- DO STORE("NO CHANGE")
- QUIT
- +14 IF SDORG
- IF $PIECE(SDSCDATA,U,5)=0
- DO STORE("SCNSC")
- QUIT
- +15 IF 'SDORG
- IF $PIECE(SDSCDATA,U,5)
- DO STORE("NSCSC")
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +16 ;
- PRT ; Print
- +1 KILL TOTAL
- +2 SET SDHDR="User Summary Data Report"
- +3 DO HDR
- IF $GET(SDABRT)=1
- QUIT
- +4 FOR TYP="REVIEW","SCNSC","NSCSC","NO CHANGE"
- SET TOTAL(TYP)=0
- +5 SET LEV1=""
- +6 FOR
- SET LEV1=$ORDER(^TMP("SDSCUSR",$JOB,LEV1))
- IF LEV1=""
- QUIT
- Begin DoDot:1
- +7 IF L+4>IOSL
- DO HDR
- IF $GET(SDABRT)=1
- QUIT
- +8 WRITE !,LEV1
- SET L=L+1
- +9 SET COL=30
- FOR TYP="REVIEW","SCNSC","NSCSC","NO CHANGE"
- SET COL=COL+10
- Begin DoDot:2
- +10 SET AMT=+$GET(^TMP("SDSCUSR",$JOB,LEV1,TYP))
- SET DTOT(LEV1,TYP)=$GET(DTOT(LEV1,TYP))+AMT
- SET TOTAL(TYP)=$GET(TOTAL(TYP))+AMT
- +11 WRITE ?COL,$JUSTIFY(AMT,7)
- End DoDot:2
- End DoDot:1
- IF $GET(SDABRT)=1
- QUIT
- +12 IF $GET(SDABRT)=1
- QUIT
- +13 SET COL=30
- SET L=L+1
- WRITE !
- IF L+4>IOSL
- DO HDR
- IF $GET(SDABRT)=1
- QUIT
- +14 FOR TYP="REVIEW","SCNSC","NSCSC","NO CHANGE"
- SET COL=COL+10
- Begin DoDot:1
- +15 WRITE ?COL,"-------"
- End DoDot:1
- +16 SET COL=30
- SET L=L+1
- WRITE !,"TOTAL"
- +17 FOR TYP="REVIEW","SCNSC","NSCSC","NO CHANGE"
- SET COL=COL+10
- Begin DoDot:1
- +18 WRITE ?COL,$JUSTIFY($GET(TOTAL(TYP)),7)
- End DoDot:1
- +19 QUIT
- +20 ;
- EXT ;
- +1 IF CT>1
- IF $GET(SDABRT)'=1
- DO PRTT
- +2 DO RPTEND^SDSCRPT1
- +3 ;
- EXIT ;
- +1 KILL SDNWPV,SDPVCN,SDSCBDT,SDSCEDT,SDSCDATA,SDSCDIV,SDSCDNM,DIV,EDIV,TOTAL
- +2 KILL SDHDR,SDSCTDT,SDEDT,I,L,P,SUBTOT,Y,POP,GROUP,SCLN,DTOUT,DUOUT,DTOT
- +3 KILL ^TMP("SDSCUSR",$JOB)
- KILL LEV1,TYP
- +4 QUIT
- +5 ;
- STORE(VAL) ; Total up and Store
- +1 SET ^TMP("SDSCUSR",$JOB,UNAME,VAL)=$GET(^TMP("SDSCUSR",$JOB,UNAME,VAL))+1
- +2 SET ^TMP("SDSCUSR",$JOB,UNAME,VAL,SDOE)=""
- +3 KILL VAL
- +4 QUIT
- +5 ;
- HDR ; Header
- +1 USE IO
- DO STDHDR^SDSCRPT2
- IF $GET(SDABRT)=1
- QUIT
- +2 SET SDNWPV=1
- +3 WRITE SDHDR,?67,"PAGE: ",P
- +4 WRITE !,?5,"For Encounters Dated ",$$FMTE^XLFDT(SDSCTDT,2)," THRU ",$$FMTE^XLFDT(SDEDT,2)_" By Division: "_SDSCDNM
- +5 WRITE !?35,"SET to REVIEW",?50,"SC to NSC",?61,"NSC to SC",?72,"SC KEPT",!
- +6 FOR I=1:1:79
- WRITE "-"
- +7 QUIT
- +8 ;
- HDR1 ;
- +1 NEW HHDR,HHDR1,HHDR2,HHDR3,HHDR4,I
- +2 USE IO
- DO STDHDR^SDSCRPT2
- IF $GET(SDABRT)=1
- QUIT
- +3 IF $EXTRACT(THDR,$LENGTH(THDR))=","
- SET THDR=$EXTRACT(THDR,1,$LENGTH(THDR)-1)
- +4 WRITE SDHDR,?67,"PAGE: ",P
- +5 SET HHDR1="For Encounters Dated "_$$FMTE^XLFDT(SDSCTDT,2)_" THRU "_$$FMTE^XLFDT(SDEDT,2)_" TOTAL for "
- +6 SET HHDR2=THDR
- +7 IF $LENGTH(HHDR1)+$LENGTH(HHDR2)>IOM
- Begin DoDot:1
- +8 SET HHDR3=$PIECE(HHDR2,",",1)
- SET HHDR4=$PIECE(HHDR2,",",2,99)
- +9 SET HHDR=HHDR1_HHDR3
- +10 IF HHDR4'=""
- SET HHDR=HHDR_","
- End DoDot:1
- +11 IF $LENGTH(HHDR1)+$LENGTH(HHDR2)'>IOM
- Begin DoDot:1
- +12 SET HHDR=HHDR1_HHDR2
- End DoDot:1
- +13 WRITE !,HHDR
- +14 IF $GET(HHDR4)'=""
- WRITE !,?5,HHDR4
- +15 WRITE !?40," REVIEW",?50,"SC CHNG",?60,"SC KEPT",!
- +16 FOR I=1:1:79
- WRITE "-"
- +17 QUIT
- +18 ;
- PRTT ;
- +1 DO HDR1
- IF $GET(SDABRT)=1
- QUIT
- +2 FOR TYP="REVIEW","SCNSC","NSCSC","NO CHANGE"
- SET TOTAL(TYP)=0
- +3 SET LEV1=""
- +4 FOR
- SET LEV1=$ORDER(DTOT(LEV1))
- IF LEV1=""
- QUIT
- Begin DoDot:1
- +5 IF L+4>IOSL
- DO HDR1
- IF $GET(SDABRT)=1
- QUIT
- +6 WRITE !,LEV1
- SET L=L+1
- +7 SET COL=30
- FOR TYP="REVIEW","SCNSC","NSCSC","NO CHANGE"
- SET COL=COL+10
- Begin DoDot:2
- +8 SET AMT=DTOT(LEV1,TYP)
- SET TOTAL(TYP)=$GET(TOTAL(TYP))+AMT
- +9 WRITE ?COL,$JUSTIFY(AMT,7)
- End DoDot:2
- End DoDot:1
- +10 SET COL=30
- SET L=L+1
- WRITE !
- IF L+4>IOSL
- DO HDR1
- IF $GET(SDABRT)=1
- QUIT
- +11 FOR TYP="REVIEW","SCNSC","NSCSC","NO CHANGE"
- SET COL=COL+10
- Begin DoDot:1
- +12 WRITE ?COL,"-------"
- End DoDot:1
- +13 SET COL=30
- SET L=L+1
- WRITE !,"TOTAL"
- +14 FOR TYP="REVIEW","SCNSC","NSCSC","NO CHANGE"
- SET COL=COL+10
- Begin DoDot:1
- +15 WRITE ?COL,$JUSTIFY($GET(TOTAL(TYP)),7)
- End DoDot:1
- +16 QUIT