SDSCMSR ;ALB/JAM/RBS - ASCD Managers Summary Data Report ; 3/5/07 11:44am
;;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 ZTQUEUED,POP,ZTRTN,ZTDTH,ZTDESC,ZTSAVE,SDSCDVSL,SDSCDVLN,WHO,DIR,X,Y
N SDSCBDT
K ^TMP("SDSCMGR",$J)
; 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
S (SDSCBDT,SDSCEDT)=""
S SDSCBDT=$O(^SCE("B",""))\1,SDSCEDT=DT
D GETDATE1^SDSCOMP I SDSCTDT="" G EXIT
K DIR,X,Y
S DIR(0)="S^A:All Encounters;C:Compiled ASCD Encounters Only"
S DIR("A")="Select to check ",DIR("B")="Compiled ASCD Encounters Only"
D ^DIR
I $G(DTOUT)!($G(DUOUT)) G EXIT
S WHO=Y
K %ZIS,IOP,IOC,ZTIO S %ZIS="MQ" D ^%ZIS G:POP EXIT
I $D(IO("Q")) D G EXIT
. S ZTRTN="BEG^SDSCMSR",ZTDTH=$H,ZTDESC="ASCD Manager Summary Report"
. S ZTSAVE("WHO")="",ZTSAVE("SDSCBDT")="",ZTSAVE("SDSCEDT")="",ZTSAVE("SDSCDVSL")=""
. S ZTSAVE("SDSCDVLN")="",ZTSAVE("SDEDT")="",ZTSAVE("SDSCTDT")=""
. K IO("Q") D ^%ZTLOAD W !,"REQUEST QUEUED"
;
BEG ; Begin report
N DTOTAL,DATOTAL,CT,P,L,SDABRT,AJ,DTOT,SDSCDIV,SDSCDNM,THDR,AI
S (DTOTAL,DATOTAL,CT)=0
S (P,L,SDABRT)=0
F AJ="VBA","NO CHANGE","SCNSC","NSCSC","REV","NOT","NPROC" S DTOT(AJ)=0
S SDSCDIV=$S(SDSCDVSL'[SDSCDVLN:SDSCDVSL,1:"")
I SDSCDIV="" S SDSCDNM="ALL" D BLD G EXT
I SDSCDIV'="" D
. S THDR=""
. F AI=1:1:$L(SDSCDVSL,",") S SDSCDIV=$P(SDSCDVSL,",",AI) Q:SDSCDIV="" D Q:$G(SDABRT)=1
.. S SDSCDNM=$P(^DG(40.8,SDSCDIV,0),"^",1),THDR=THDR_SDSCDNM_",",CT=CT+1 D BLD
G EXT
;
BLD ;
N SDOEDT,ATOTAL,ENC,SDOE0,TOTAL,EDIV,SDEFLG,SI,SUBTOT,SDNWPV,DIV
N SBTOT,SDOE,SDSCDATA,SCVAL
I WHO="A" S SDOEDT=SDSCTDT,ATOTAL=0 D
. I '$D(ZTQUEUED) D EN^DDIOL("Please wait while I count encounters")
. F S SDOEDT=$O(^SCE("B",SDOEDT)) Q:SDOEDT\1>SDEDT!(SDOEDT="") D
.. S ENC="" F S ENC=$O(^SCE("B",SDOEDT,ENC)) Q:ENC="" D
... S SDOE0=$$GETOE^SDOE(ENC,0)
... I SDSCDIV'="" Q:$P(SDOE0,U,11)'=SDSCDIV
... I $P(SDOE0,U,12)=2 S ATOTAL=ATOTAL+1 I '$D(ZTQUEUED) W:ATOTAL#100=0 "."
;
FND ;
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
.. I SDSCDIV'="" Q:$P(^SDSC(409.48,SDOE,0),U,12)'=SDSCDIV
.. S EDIV=$P(^SDSC(409.48,SDOE,0),U,12),TOTAL=TOTAL+1
.. ; if division is null, check for value
.. I EDIV="" D
... S EDIV=$P($G(^SCE(SDOE,0)),U,11)
... I EDIV="" S EDIV="~" Q
... D UPD(SDOE,.12,EDIV,"I")
.. ; Check for not editable
.. S SDEFLG=0 D CHECK^SDSCEDT
.. I 'SDEFLG D STORE("NOT") W "!X" Q
.. 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'=""
...I '+SCVAL D STORE("NO CHANGE") Q
...I $P(SCVAL,"^",2) D STORE("SCNSC") Q
...D STORE("NSCSC")
;
PRT ; Print report
S SUBTOT=0
S SDHDR="Managers Summary Data Report"
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)," For Division: ",SDSCDNM,!!
W ! F I=1:1:79 W "-"
;
I WHO="A" W !,"All Checked Out Encounters: ",?52,$J(ATOTAL,10) S DATOTAL=DATOTAL+ATOTAL
W !,"ASCD Encounters that are potentially billable: ",?55,$J(TOTAL,7) S DTOTAL=DTOTAL+TOTAL
W !,?55,$J("-------",7)
S SBTOT=0,DIV="" F S DIV=$O(^TMP("SDSCMGR",$J,"VBA",DIV)) Q:DIV="" D
. S SBTOT=SBTOT+^TMP("SDSCMGR",$J,"VBA",DIV)
W !,"Encounters verified with Rated Disability Codes: ",?55,$J(SBTOT,7) S SUBTOT=SUBTOT+SBTOT,DTOT("VBA")=DTOT("VBA")+SBTOT
S SBTOT=0,DIV="" F S DIV=$O(^TMP("SDSCMGR",$J,"NO CHANGE",DIV)) Q:DIV="" D
. S SBTOT=SBTOT+^TMP("SDSCMGR",$J,"NO CHANGE",DIV)
W !,"Encounters where SC NOT changed: ",?55,$J(SBTOT,7) S SUBTOT=SUBTOT+SBTOT,DTOT("NO CHANGE")=DTOT("NO CHANGE")+SBTOT
S SBTOT=0,DIV="" F S DIV=$O(^TMP("SDSCMGR",$J,"SCNSC",DIV)) Q:DIV="" D
. S SBTOT=SBTOT+^TMP("SDSCMGR",$J,"SCNSC",DIV)
W !,"Encounters where SC was changed to NSC: ",?55,$J(SBTOT,7) S SUBTOT=SUBTOT+SBTOT,DTOT("SCNSC")=DTOT("SCNSC")+SBTOT
S SBTOT=0,DIV="" F S DIV=$O(^TMP("SDSCMGR",$J,"NSCSC",DIV)) Q:DIV="" D
. S SBTOT=SBTOT+^TMP("SDSCMGR",$J,"NSCSC",DIV)
W !,"Encounters where NSC was changed to SC: ",?55,$J(SBTOT,7) S SUBTOT=SUBTOT+SBTOT,DTOT("NSCSC")=DTOT("NSCSC")+SBTOT
S SBTOT=0,DIV="" F S DIV=$O(^TMP("SDSCMGR",$J,"REV",DIV)) Q:DIV="" D
. S SBTOT=SBTOT+^TMP("SDSCMGR",$J,"REV",DIV)
W !,"Encounters sent to Clinical Review: ",?55,$J(SBTOT,7) S SUBTOT=SUBTOT+SBTOT,DTOT("REV")=DTOT("REV")+SBTOT
S SBTOT=0,DIV="" F S DIV=$O(^TMP("SDSCMGR",$J,"NOT",DIV)) Q:DIV="" D
. S SBTOT=SBTOT+^TMP("SDSCMGR",$J,"NOT",DIV)
W !,"Encounters not editable: ",?55,$J(SBTOT,7) S SUBTOT=SUBTOT+SBTOT,DTOT("NOT")=DTOT("NOT")+SBTOT
W !,"Encounters not yet processed: ",?55,$J(TOTAL-SUBTOT,7) S DTOT("NPROC")=DTOT("NPROC")+(TOTAL-SUBTOT)
W !!!
K ^TMP("SDSCMGR",$J)
Q
;
UPD(SDENC,SDFLD,SDVAL,SDFLG) ; Update record
N SDPD
S SDPD(409.48,SDENC_",",SDFLD)=SDVAL
D FILE^DIE(SDFLG,"SDPD","ERROR")
Q
EXT ;
I CT>1,$G(SDABRT)'=1 D PRTT
D RPTEND^SDSCRPT1
;
EXIT ;
K SDTYPE,SDSCTDT,SDEDT,SDSCEDT,SCLN,DIRUT,DTOUT,DUOUT,SDHDR
K SDSCMSG,SDFLG,SDOEDAT,SDOSC,SDPAT,SDSCPKG,SDSCSRC,SDV0
Q
STORE(VAL) ; Total up and Store
S ^TMP("SDSCMGR",$J,VAL,EDIV)=$G(^TMP("SDSCMGR",$J,VAL,EDIV))+1
S ^TMP("SDSCMGR",$J,VAL,EDIV,SDOE)=""
K VAL
Q
;
PRTT ; Print total page
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 ! F I=1:1:79 W "-"
;
I WHO="A" W !,"All Checked Out Encounters: ",?52,$J(DATOTAL,10)
W !,"ASCD Encounters w/ SC='Yes' & potentially billable: ",?55,$J(DTOTAL,7)
W !,?55,$J("-------",7)
W !,"Encounters verified with Rated Disability Codes: ",?55,$J(DTOT("VBA"),7)
W !,"Encounters where SC NOT changed: ",?55,$J(DTOT("NO CHANGE"),7)
W !,"Encounters where SC was changed to NSC: ",?55,$J(DTOT("SCNSC"),7)
W !,"Encounters where NSC was changed to SC: ",?55,$J(DTOT("NSCSC"),7)
W !,"Encounters sent to Clinical Review: ",?55,$J(DTOT("REV"),7)
W !,"Encounters not editable: ",?55,$J(DTOT("NOT"),7)
W !,"Encounters not yet processed: ",?55,$J(DTOT("NPROC"),7)
W !!!
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDSCMSR 7009 printed Apr 09, 2024@21:42:17 Page 2
SDSCMSR ;ALB/JAM/RBS - ASCD Managers Summary Data Report ; 3/5/07 11:44am
+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 ZTQUEUED,POP,ZTRTN,ZTDTH,ZTDESC,ZTSAVE,SDSCDVSL,SDSCDVLN,WHO,DIR,X,Y
+2 NEW SDSCBDT
+3 KILL ^TMP("SDSCMGR",$JOB)
+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 ; Get start and end date for report
+10 SET (SDSCBDT,SDSCEDT)=""
+11 SET SDSCBDT=$ORDER(^SCE("B",""))\1
SET SDSCEDT=DT
+12 DO GETDATE1^SDSCOMP
IF SDSCTDT=""
GOTO EXIT
+13 KILL DIR,X,Y
+14 SET DIR(0)="S^A:All Encounters;C:Compiled ASCD Encounters Only"
+15 SET DIR("A")="Select to check "
SET DIR("B")="Compiled ASCD Encounters Only"
+16 DO ^DIR
+17 IF $GET(DTOUT)!($GET(DUOUT))
GOTO EXIT
+18 SET WHO=Y
+19 KILL %ZIS,IOP,IOC,ZTIO
SET %ZIS="MQ"
DO ^%ZIS
if POP
GOTO EXIT
+20 IF $DATA(IO("Q"))
Begin DoDot:1
+21 SET ZTRTN="BEG^SDSCMSR"
SET ZTDTH=$HOROLOG
SET ZTDESC="ASCD Manager Summary Report"
+22 SET ZTSAVE("WHO")=""
SET ZTSAVE("SDSCBDT")=""
SET ZTSAVE("SDSCEDT")=""
SET ZTSAVE("SDSCDVSL")=""
+23 SET ZTSAVE("SDSCDVLN")=""
SET ZTSAVE("SDEDT")=""
SET ZTSAVE("SDSCTDT")=""
+24 KILL IO("Q")
DO ^%ZTLOAD
WRITE !,"REQUEST QUEUED"
End DoDot:1
GOTO EXIT
+25 ;
BEG ; Begin report
+1 NEW DTOTAL,DATOTAL,CT,P,L,SDABRT,AJ,DTOT,SDSCDIV,SDSCDNM,THDR,AI
+2 SET (DTOTAL,DATOTAL,CT)=0
+3 SET (P,L,SDABRT)=0
+4 FOR AJ="VBA","NO CHANGE","SCNSC","NSCSC","REV","NOT","NPROC"
SET DTOT(AJ)=0
+5 SET SDSCDIV=$SELECT(SDSCDVSL'[SDSCDVLN:SDSCDVSL,1:"")
+6 IF SDSCDIV=""
SET SDSCDNM="ALL"
DO BLD
GOTO EXT
+7 IF SDSCDIV'=""
Begin DoDot:1
+8 SET THDR=""
+9 FOR AI=1:1:$LENGTH(SDSCDVSL,",")
SET SDSCDIV=$PIECE(SDSCDVSL,",",AI)
if SDSCDIV=""
QUIT
Begin DoDot:2
+10 SET SDSCDNM=$PIECE(^DG(40.8,SDSCDIV,0),"^",1)
SET THDR=THDR_SDSCDNM_","
SET CT=CT+1
DO BLD
End DoDot:2
if $GET(SDABRT)=1
QUIT
End DoDot:1
+11 GOTO EXT
+12 ;
BLD ;
+1 NEW SDOEDT,ATOTAL,ENC,SDOE0,TOTAL,EDIV,SDEFLG,SI,SUBTOT,SDNWPV,DIV
+2 NEW SBTOT,SDOE,SDSCDATA,SCVAL
+3 IF WHO="A"
SET SDOEDT=SDSCTDT
SET ATOTAL=0
Begin DoDot:1
+4 IF '$DATA(ZTQUEUED)
DO EN^DDIOL("Please wait while I count encounters")
+5 FOR
SET SDOEDT=$ORDER(^SCE("B",SDOEDT))
if SDOEDT\1>SDEDT!(SDOEDT="")
QUIT
Begin DoDot:2
+6 SET ENC=""
FOR
SET ENC=$ORDER(^SCE("B",SDOEDT,ENC))
if ENC=""
QUIT
Begin DoDot:3
+7 SET SDOE0=$$GETOE^SDOE(ENC,0)
+8 IF SDSCDIV'=""
if $PIECE(SDOE0,U,11)'=SDSCDIV
QUIT
+9 IF $PIECE(SDOE0,U,12)=2
SET ATOTAL=ATOTAL+1
IF '$DATA(ZTQUEUED)
if ATOTAL#100=0
WRITE "."
End DoDot:3
End DoDot:2
End DoDot:1
+10 ;
FND ;
+1 SET SDOEDT=SDSCTDT
SET TOTAL=0
+2 FOR
SET SDOEDT=$ORDER(^SDSC(409.48,"AE",SDOEDT))
if SDOEDT\1>SDEDT!(SDOEDT="")
QUIT
Begin DoDot:1
+3 SET SDOE=""
+4 FOR
SET SDOE=$ORDER(^SDSC(409.48,"AE",SDOEDT,SDOE))
if SDOE=""
QUIT
Begin DoDot:2
+5 IF SDSCDIV'=""
if $PIECE(^SDSC(409.48,SDOE,0),U,12)'=SDSCDIV
QUIT
+6 SET EDIV=$PIECE(^SDSC(409.48,SDOE,0),U,12)
SET TOTAL=TOTAL+1
+7 ; if division is null, check for value
+8 IF EDIV=""
Begin DoDot:3
+9 SET EDIV=$PIECE($GET(^SCE(SDOE,0)),U,11)
+10 IF EDIV=""
SET EDIV="~"
QUIT
+11 DO UPD(SDOE,.12,EDIV,"I")
End DoDot:3
+12 ; Check for not editable
+13 SET SDEFLG=0
DO CHECK^SDSCEDT
+14 IF 'SDEFLG
DO STORE("NOT")
WRITE "!X"
QUIT
+15 SET SDSCDATA=$GET(^SDSC(409.48,SDOE,0))
IF SDSCDATA=""
QUIT
+16 IF +$PIECE(SDSCDATA,U,9)
IF +$PIECE(SDSCDATA,U,6)
DO STORE("VBA")
QUIT
+17 IF $PIECE(SDSCDATA,U,5)="R"
DO STORE("REV")
QUIT
+18 IF $PIECE(SDSCDATA,U,5)="C"
SET SCVAL=$$SCHNG^SDSCUTL(SDOE)
if SCVAL'=""
Begin DoDot:3
+19 IF '+SCVAL
DO STORE("NO CHANGE")
QUIT
+20 IF $PIECE(SCVAL,"^",2)
DO STORE("SCNSC")
QUIT
+21 DO STORE("NSCSC")
End DoDot:3
End DoDot:2
End DoDot:1
+22 ;
PRT ; Print report
+1 SET SUBTOT=0
+2 SET SDHDR="Managers Summary Data Report"
+3 USE IO
DO STDHDR^SDSCRPT2
if $GET(SDABRT)=1
QUIT
+4 SET SDNWPV=1
+5 WRITE SDHDR,?67,"PAGE: ",P
+6 WRITE !,?5,"For Encounters Dated ",$$FMTE^XLFDT(SDSCTDT,2)," THRU ",$$FMTE^XLFDT(SDEDT,2)," For Division: ",SDSCDNM,!!
+7 WRITE !
FOR I=1:1:79
WRITE "-"
+8 ;
+9 IF WHO="A"
WRITE !,"All Checked Out Encounters: ",?52,$JUSTIFY(ATOTAL,10)
SET DATOTAL=DATOTAL+ATOTAL
+10 WRITE !,"ASCD Encounters that are potentially billable: ",?55,$JUSTIFY(TOTAL,7)
SET DTOTAL=DTOTAL+TOTAL
+11 WRITE !,?55,$JUSTIFY("-------",7)
+12 SET SBTOT=0
SET DIV=""
FOR
SET DIV=$ORDER(^TMP("SDSCMGR",$JOB,"VBA",DIV))
if DIV=""
QUIT
Begin DoDot:1
+13 SET SBTOT=SBTOT+^TMP("SDSCMGR",$JOB,"VBA",DIV)
End DoDot:1
+14 WRITE !,"Encounters verified with Rated Disability Codes: ",?55,$JUSTIFY(SBTOT,7)
SET SUBTOT=SUBTOT+SBTOT
SET DTOT("VBA")=DTOT("VBA")+SBTOT
+15 SET SBTOT=0
SET DIV=""
FOR
SET DIV=$ORDER(^TMP("SDSCMGR",$JOB,"NO CHANGE",DIV))
if DIV=""
QUIT
Begin DoDot:1
+16 SET SBTOT=SBTOT+^TMP("SDSCMGR",$JOB,"NO CHANGE",DIV)
End DoDot:1
+17 WRITE !,"Encounters where SC NOT changed: ",?55,$JUSTIFY(SBTOT,7)
SET SUBTOT=SUBTOT+SBTOT
SET DTOT("NO CHANGE")=DTOT("NO CHANGE")+SBTOT
+18 SET SBTOT=0
SET DIV=""
FOR
SET DIV=$ORDER(^TMP("SDSCMGR",$JOB,"SCNSC",DIV))
if DIV=""
QUIT
Begin DoDot:1
+19 SET SBTOT=SBTOT+^TMP("SDSCMGR",$JOB,"SCNSC",DIV)
End DoDot:1
+20 WRITE !,"Encounters where SC was changed to NSC: ",?55,$JUSTIFY(SBTOT,7)
SET SUBTOT=SUBTOT+SBTOT
SET DTOT("SCNSC")=DTOT("SCNSC")+SBTOT
+21 SET SBTOT=0
SET DIV=""
FOR
SET DIV=$ORDER(^TMP("SDSCMGR",$JOB,"NSCSC",DIV))
if DIV=""
QUIT
Begin DoDot:1
+22 SET SBTOT=SBTOT+^TMP("SDSCMGR",$JOB,"NSCSC",DIV)
End DoDot:1
+23 WRITE !,"Encounters where NSC was changed to SC: ",?55,$JUSTIFY(SBTOT,7)
SET SUBTOT=SUBTOT+SBTOT
SET DTOT("NSCSC")=DTOT("NSCSC")+SBTOT
+24 SET SBTOT=0
SET DIV=""
FOR
SET DIV=$ORDER(^TMP("SDSCMGR",$JOB,"REV",DIV))
if DIV=""
QUIT
Begin DoDot:1
+25 SET SBTOT=SBTOT+^TMP("SDSCMGR",$JOB,"REV",DIV)
End DoDot:1
+26 WRITE !,"Encounters sent to Clinical Review: ",?55,$JUSTIFY(SBTOT,7)
SET SUBTOT=SUBTOT+SBTOT
SET DTOT("REV")=DTOT("REV")+SBTOT
+27 SET SBTOT=0
SET DIV=""
FOR
SET DIV=$ORDER(^TMP("SDSCMGR",$JOB,"NOT",DIV))
if DIV=""
QUIT
Begin DoDot:1
+28 SET SBTOT=SBTOT+^TMP("SDSCMGR",$JOB,"NOT",DIV)
End DoDot:1
+29 WRITE !,"Encounters not editable: ",?55,$JUSTIFY(SBTOT,7)
SET SUBTOT=SUBTOT+SBTOT
SET DTOT("NOT")=DTOT("NOT")+SBTOT
+30 WRITE !,"Encounters not yet processed: ",?55,$JUSTIFY(TOTAL-SUBTOT,7)
SET DTOT("NPROC")=DTOT("NPROC")+(TOTAL-SUBTOT)
+31 WRITE !!!
+32 KILL ^TMP("SDSCMGR",$JOB)
+33 QUIT
+34 ;
UPD(SDENC,SDFLD,SDVAL,SDFLG) ; Update record
+1 NEW SDPD
+2 SET SDPD(409.48,SDENC_",",SDFLD)=SDVAL
+3 DO FILE^DIE(SDFLG,"SDPD","ERROR")
+4 QUIT
EXT ;
+1 IF CT>1
IF $GET(SDABRT)'=1
DO PRTT
+2 DO RPTEND^SDSCRPT1
+3 ;
EXIT ;
+1 KILL SDTYPE,SDSCTDT,SDEDT,SDSCEDT,SCLN,DIRUT,DTOUT,DUOUT,SDHDR
+2 KILL SDSCMSG,SDFLG,SDOEDAT,SDOSC,SDPAT,SDSCPKG,SDSCSRC,SDV0
+3 QUIT
STORE(VAL) ; Total up and Store
+1 SET ^TMP("SDSCMGR",$JOB,VAL,EDIV)=$GET(^TMP("SDSCMGR",$JOB,VAL,EDIV))+1
+2 SET ^TMP("SDSCMGR",$JOB,VAL,EDIV,SDOE)=""
+3 KILL VAL
+4 QUIT
+5 ;
PRTT ; Print total page
+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 !
FOR I=1:1:79
WRITE "-"
+16 ;
+17 IF WHO="A"
WRITE !,"All Checked Out Encounters: ",?52,$JUSTIFY(DATOTAL,10)
+18 WRITE !,"ASCD Encounters w/ SC='Yes' & potentially billable: ",?55,$JUSTIFY(DTOTAL,7)
+19 WRITE !,?55,$JUSTIFY("-------",7)
+20 WRITE !,"Encounters verified with Rated Disability Codes: ",?55,$JUSTIFY(DTOT("VBA"),7)
+21 WRITE !,"Encounters where SC NOT changed: ",?55,$JUSTIFY(DTOT("NO CHANGE"),7)
+22 WRITE !,"Encounters where SC was changed to NSC: ",?55,$JUSTIFY(DTOT("SCNSC"),7)
+23 WRITE !,"Encounters where NSC was changed to SC: ",?55,$JUSTIFY(DTOT("NSCSC"),7)
+24 WRITE !,"Encounters sent to Clinical Review: ",?55,$JUSTIFY(DTOT("REV"),7)
+25 WRITE !,"Encounters not editable: ",?55,$JUSTIFY(DTOT("NOT"),7)
+26 WRITE !,"Encounters not yet processed: ",?55,$JUSTIFY(DTOT("NPROC"),7)
+27 WRITE !!!
+28 QUIT
