SDSCPRV ;ALB/JAM/RBS - ASCD Provider Total Report ; 1/19/07 12:46pm
;;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 gives a total of the number of encounters that meet
; the criteria: SC='Yes', auto-verified, and changed
Q
EN ; Entry Point
N DIR,SDSCDVSL,SDSCDVLN,X,Y,ZTQUEUED,POP,ZTRTN,ZTDTH,ZTDESC,ZTSAVE
; Get Divisions
D DIV^SDSCUTL
D ^DIR
I $G(DTOUT)!($G(DUOUT)) G EXIT
S SDSCDVSL=Y,SDSCDVLN=SCLN
; Get start and end date for report
D GETDATE^SDSCOMP I SDSCTDT="" G EXIT
K %ZIS,IOP,IOC,ZTIO S %ZIS="MQ" D ^%ZIS G:POP EXIT
I $D(IO("Q")) D G EXIT
. S ZTRTN="BEG^SDSCPRV",ZTDTH=$H,ZTDESC="ASCD Provider 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 SDPROV,SDOEDT,SDPRNM,SDOE,SDSCDATA,TOTAL,TYP,LEV1,COL,AMT,SCVAL
K ^TMP("SDSCPRV",$J)
S SDPROV=0
F S SDPROV=$O(^SDSC(409.48,"AF",SDPROV)) Q:'SDPROV D
. S SDOEDT=SDSCTDT,SDPRNM=$$UP^XLFSTR($$NAME^XUSER(SDPROV,"F"))
. F S SDOEDT=$O(^SDSC(409.48,"AF",SDPROV,SDOEDT)) Q:SDOEDT\1>SDEDT!(SDOEDT="") D
.. S SDOE=""
.. F S SDOE=$O(^SDSC(409.48,"AF",SDPROV,SDOEDT,SDOE)) Q:'SDOE D
... I SDSCDIV'="" Q:$P(^SDSC(409.48,SDOE,0),U,12)'=SDSCDIV
... S SDSCDATA=^SDSC(409.48,SDOE,0)
... I +$P(SDSCDATA,U,9),+$P(SDSCDATA,U,6) D STORE("VBA") 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
K TOTAL
S SDHDR="Provider Summary Data Report"
D HDR G EXT:$G(SDABRT)=1
F TYP="VBA","SCNSC","NSCSC","NO CHANGE","NEW" S TOTAL(TYP)=0
S LEV1=""
F S LEV1=$O(^TMP("SDSCPRV",$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=20 F TYP="VBA","SCNSC","NSCSC","NO CHANGE","NEW" S COL=COL+10 D
.. S AMT=+$G(^TMP("SDSCPRV",$J,LEV1,TYP)),SBTOT(LEV1,TYP)=$G(SBTOT(LEV1,TYP))+AMT,TOTAL(TYP)=$G(TOTAL(TYP))+AMT
.. W ?COL,$J(AMT,7)
I $G(SDABRT)=1 Q
S COL=20,L=L+1 W ! I L+4>IOSL D HDR Q:$G(SDABRT)=1
F TYP="VBA","SCNSC","NSCSC","NO CHANGE","NEW" S COL=COL+10 D
. W ?COL,"-------"
S COL=20,L=L+1 W !,"TOTAL"
F TYP="VBA","SCNSC","NSCSC","NO CHANGE","NEW" 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,SDSCBDT,SDSCEDT,EDIV,GROUP,SDSCTDT,SDEDT,I,Y,^TMP("SDSCPRV",$J)
K SDHDR,SCLN,DTOUT,DUOUT,SBTOT,TOTAL
Q
STORE(VAL) ; Total up and Store
S ^TMP("SDSCPRV",$J,SDPRNM,VAL)=$G(^TMP("SDSCPRV",$J,SDPRNM,VAL))+1
S ^TMP("SDSCPRV",$J,SDPRNM,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 !?31," VBA OK",?40,"SC to NSC",?51,"NSC to SC",?62,"SC KEPT",?74,"NEW",!
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 !?31," VBA OK",?40,"SC to NSC",?51,"NSC to SC",?62,"SC KEPT",?74,"NEW",!
F I=1:1:79 W "-"
Q
;
PRTT ;
D HDR1 Q:$G(SDABRT)=1
F TYP="VBA","SCNSC","NSCSC","NO CHANGE","NEW" S TOTAL(TYP)=0
S LEV1=""
F S LEV1=$O(SBTOT(LEV1)) Q:LEV1="" D
. I L+4>IOSL D HDR1 Q:$G(SDABRT)=1
. W !,LEV1 S L=L+1
. S COL=20 F TYP="VBA","SCNSC","NSCSC","NO CHANGE","NEW" S COL=COL+10 D
.. S AMT=SBTOT(LEV1,TYP),TOTAL(TYP)=$G(TOTAL(TYP))+AMT
.. W ?COL,$J(AMT,7)
S COL=20,L=L+1 W ! I L+4>IOSL D HDR1 Q:$G(SDABRT)=1
F TYP="VBA","SCNSC","NSCSC","NO CHANGE","NEW" S COL=COL+10 D
. W ?COL,"-------"
S COL=20,L=L+1 W !,"TOTAL"
F TYP="VBA","SCNSC","NSCSC","NO CHANGE","NEW" S COL=COL+10 D
. W ?COL,$J($G(TOTAL(TYP)),7)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDSCPRV 4887 printed Apr 09, 2024@21:52:26 Page 2
SDSCPRV ;ALB/JAM/RBS - ASCD Provider Total Report ; 1/19/07 12:46pm
+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 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,SDSCDVSL,SDSCDVLN,X,Y,ZTQUEUED,POP,ZTRTN,ZTDTH,ZTDESC,ZTSAVE
+2 ; Get Divisions
+3 DO DIV^SDSCUTL
+4 DO ^DIR
+5 IF $GET(DTOUT)!($GET(DUOUT))
GOTO EXIT
+6 SET SDSCDVSL=Y
SET SDSCDVLN=SCLN
+7 ; Get start and end date for report
+8 DO GETDATE^SDSCOMP
IF SDSCTDT=""
GOTO EXIT
+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^SDSCPRV"
SET ZTDTH=$HOROLOG
SET ZTDESC="ASCD Provider 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 SDPROV,SDOEDT,SDPRNM,SDOE,SDSCDATA,TOTAL,TYP,LEV1,COL,AMT,SCVAL
+2 KILL ^TMP("SDSCPRV",$JOB)
+3 SET SDPROV=0
+4 FOR
SET SDPROV=$ORDER(^SDSC(409.48,"AF",SDPROV))
if 'SDPROV
QUIT
Begin DoDot:1
+5 SET SDOEDT=SDSCTDT
SET SDPRNM=$$UP^XLFSTR($$NAME^XUSER(SDPROV,"F"))
+6 FOR
SET SDOEDT=$ORDER(^SDSC(409.48,"AF",SDPROV,SDOEDT))
if SDOEDT\1>SDEDT!(SDOEDT="")
QUIT
Begin DoDot:2
+7 SET SDOE=""
+8 FOR
SET SDOE=$ORDER(^SDSC(409.48,"AF",SDPROV,SDOEDT,SDOE))
if 'SDOE
QUIT
Begin DoDot:3
+9 IF SDSCDIV'=""
if $PIECE(^SDSC(409.48,SDOE,0),U,12)'=SDSCDIV
QUIT
+10 SET SDSCDATA=^SDSC(409.48,SDOE,0)
+11 IF +$PIECE(SDSCDATA,U,9)
IF +$PIECE(SDSCDATA,U,6)
DO STORE("VBA")
QUIT
+12 IF $PIECE(SDSCDATA,U,5)="C"
SET SCVAL=$$SCHNG^SDSCUTL(SDOE)
if SCVAL'=""
Begin DoDot:4
+13 IF '+SCVAL
DO STORE("NO CHANGE")
QUIT
+14 IF $PIECE(SCVAL,"^",2)
DO STORE("SCNSC")
QUIT
+15 DO STORE("NSCSC")
End DoDot:4
QUIT
+16 DO STORE("NEW")
End DoDot:3
End DoDot:2
End DoDot:1
+17 ;
PRT ; Print
+1 KILL TOTAL
+2 SET SDHDR="Provider Summary Data Report"
+3 DO HDR
if $GET(SDABRT)=1
GOTO EXT
+4 FOR TYP="VBA","SCNSC","NSCSC","NO CHANGE","NEW"
SET TOTAL(TYP)=0
+5 SET LEV1=""
+6 FOR
SET LEV1=$ORDER(^TMP("SDSCPRV",$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=20
FOR TYP="VBA","SCNSC","NSCSC","NO CHANGE","NEW"
SET COL=COL+10
Begin DoDot:2
+10 SET AMT=+$GET(^TMP("SDSCPRV",$JOB,LEV1,TYP))
SET SBTOT(LEV1,TYP)=$GET(SBTOT(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=20
SET L=L+1
WRITE !
IF L+4>IOSL
DO HDR
if $GET(SDABRT)=1
QUIT
+14 FOR TYP="VBA","SCNSC","NSCSC","NO CHANGE","NEW"
SET COL=COL+10
Begin DoDot:1
+15 WRITE ?COL,"-------"
End DoDot:1
+16 SET COL=20
SET L=L+1
WRITE !,"TOTAL"
+17 FOR TYP="VBA","SCNSC","NSCSC","NO CHANGE","NEW"
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,SDSCBDT,SDSCEDT,EDIV,GROUP,SDSCTDT,SDEDT,I,Y,^TMP("SDSCPRV",$JOB)
+2 KILL SDHDR,SCLN,DTOUT,DUOUT,SBTOT,TOTAL
+3 QUIT
STORE(VAL) ; Total up and Store
+1 SET ^TMP("SDSCPRV",$JOB,SDPRNM,VAL)=$GET(^TMP("SDSCPRV",$JOB,SDPRNM,VAL))+1
+2 SET ^TMP("SDSCPRV",$JOB,SDPRNM,VAL,SDOE)=""
+3 KILL VAL
+4 QUIT
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 !?31," VBA OK",?40,"SC to NSC",?51,"NSC to SC",?62,"SC KEPT",?74,"NEW",!
+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 !?31," VBA OK",?40,"SC to NSC",?51,"NSC to SC",?62,"SC KEPT",?74,"NEW",!
+16 FOR I=1:1:79
WRITE "-"
+17 QUIT
+18 ;
PRTT ;
+1 DO HDR1
if $GET(SDABRT)=1
QUIT
+2 FOR TYP="VBA","SCNSC","NSCSC","NO CHANGE","NEW"
SET TOTAL(TYP)=0
+3 SET LEV1=""
+4 FOR
SET LEV1=$ORDER(SBTOT(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=20
FOR TYP="VBA","SCNSC","NSCSC","NO CHANGE","NEW"
SET COL=COL+10
Begin DoDot:2
+8 SET AMT=SBTOT(LEV1,TYP)
SET TOTAL(TYP)=$GET(TOTAL(TYP))+AMT
+9 WRITE ?COL,$JUSTIFY(AMT,7)
End DoDot:2
End DoDot:1
+10 SET COL=20
SET L=L+1
WRITE !
IF L+4>IOSL
DO HDR1
if $GET(SDABRT)=1
QUIT
+11 FOR TYP="VBA","SCNSC","NSCSC","NO CHANGE","NEW"
SET COL=COL+10
Begin DoDot:1
+12 WRITE ?COL,"-------"
End DoDot:1
+13 SET COL=20
SET L=L+1
WRITE !,"TOTAL"
+14 FOR TYP="VBA","SCNSC","NSCSC","NO CHANGE","NEW"
SET COL=COL+10
Begin DoDot:1
+15 WRITE ?COL,$JUSTIFY($GET(TOTAL(TYP)),7)
End DoDot:1
+16 QUIT
