- 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 Jan 18, 2025@04:02:21 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