SCRPI01A ;ALB/SCK - IEMM REPORT OF INCOMPLETE ENCOUNTERS PRINT ; 6/24/97
;;5.3;Scheduling;**66**;AUG 13, 1993
Q
PRINT ; Begin printing report
; Variables
; PAGE - Page Number
; SDIV - Division Name
; SDCLN - Clinic Name
; SDNAME - Patient Name
; SDT - Encounter Date
; SCABORT - Abort report flag
;
N DASH,DBLDASH,PAGE,SDIV,SDCLN,SDNAME,SDT,SCABORT,NONAME
;
S $P(DASH,"-",IOM-1)="",$P(DBLDASH,"=",IOM-1)=""
S PAGE=0,SDIV=""
;
I '$D(^TMP("SCRPI ERR",$J)) D HDR1 Q
;
F S SDIV=$O(^TMP("SCRPI ERR",$J,SDIV)) Q:SDIV']"" D Q:$G(SCABORT)
. S SDCLN=""
. F S SDCLN=$O(^TMP("SCRPI ERR",$J,SDIV,SDCLN)) Q:SDCLN']"" D Q:$G(SCABORT)
.. D HDR(SDIV,SDCLN)
.. Q:$G(SCABORT)
.. S SDNAME=""
.. F S SDNAME=$O(^TMP("SCRPI ERR",$J,SDIV,SDCLN,SDNAME)) Q:SDNAME']"" D Q:$G(SCABORT)
... S SDT="",NONAME=0
... F S SDT=$O(^TMP("SCRPI ERR",$J,SDIV,SDCLN,SDNAME,SDT)) Q:'SDT D Q:$G(SCABORT)
.... S SDER=""
.... F S SDER=$O(^TMP("SCRPI ERR",$J,SDIV,SDCLN,SDNAME,SDT,SDER)) Q:'SDER D LINE(^TMP("SCRPI ERR",$J,SDIV,SDCLN,SDNAME,SDT,SDER,0)) Q:$G(SCABORT)
;
D SELPAGE
Q
;
LINE(SDTMP) ; Print formatted line of the report. Check if task has been stopped by user.
; Set abort flag to quit if stopped.
; Input
; SDTMP - formatted line to print
;
; Output
; SCABORT - 1 if user aborts report printing
;
; Variables
; SCERR - Error Code form #409.76
; SCERR1 - Error Description from #409.76
;
N X,X1,X2,SCERR,SCERR1,DFN
;
; ** if task has been stopped, set abort flag and quit.
I $$S^%ZTLOAD D Q
. S SCABORT=1
. W !!,"Report stopped by user"
;
I $Y>(IOSL-5) D HDR(SDIV,SDCLN)
;
; ** Check that error is still around and has not been corrected.
Q:'$G(^SD(409.75,SDER,0))
S SCERR=^SD(409.76,$P(^SD(409.75,SDER,0),U,2),0)
S SCERR1=^SD(409.76,$P(^SD(409.75,SDER,0),U,2),1)
;
S DFN=$P(SDTMP,U)
D PID^VADPT6
W !,$S('NONAME:$E(SDNAME,1,25),1:" "),?27,$S('NONAME:VA("BID"),1:" ")
W ?33,$S($P(SDTMP,U,3)]"":$P(SDTMP,U,3),1:" ")," "
W $$FMTE^XLFDT(SDT,"2FP"),?55,$S($P(SCERR,U,2)="V":"VISTA",$P(SCERR,U,2)="N":"NPCD ",1:"UNK "),?62,$P(SCERR,U)
;
; ** Parse out error description to fit report. If description length >50, then
; call parse procedure to break description into two lines.
S X=$P(SCERR1,U)
I $L(X)<50 D
. W ?68,X
E D
. K X1,X2
. D PARSE^SCRPIUT1(X,.X1,.X2,45,51)
. W ?68,X1,!?68,X2
S NONAME=1
K VA
Q
;
HDR(SDIV,SDCLN) ; Print report header, if abort flag is set, then quit
; Input
; SDIV - Division Name
; SDCLN - Clinic Name
;
; Variables
; SDL - Print line
;
N SDL,X
;
I 'PAGE,IOST?1"C-".E W @IOF
I PAGE,IOST?1"C-".E D Q:$G(SCABORT)
. S DIR(0)="E" D ^DIR K DIR S SCABORT='+$G(Y)
. W @IOF
E D
. I PAGE W @IOF
;
S PAGE=PAGE+1
W !?2,"Date: ",$$FDATE^VALM1($$DT^XLFDT),?((IOM/2)-22),"Incomplete Encounter Management Error Listing",?(IOM-13),"Page: ",PAGE
;
S X="Division: "_$S($G(SDIV)]"":SDIV,1:" ---")
D CTR^SCRPIUT1(.X,IOM)
W !,X
;
S X="Clinic: "_$S($G(SDCLN)]"":SDCLN,1:" ---")
D CTR^SCRPIUT1(.X,IOM)
W !,X
;
S X="Date Range: "_$$FMTE^XLFDT($P(SDDT,U))_" to "_$$FMTE^XLFDT($P(SDDT,U,2))
D CTR^SCRPIUT1(.X,IOM)
W !,X
;
S X="Selection Method by "_$$SELMTHD^SCRPI01(SDSEL1)_" then by "_$$SELMTHD^SCRPI01(SDSEL2)
D CTR^SCRPIUT1(.X,IOM)
W !,X
;
W !!!,?35,"Encounter",?54,"Error",?62,"Error"
W !,"Patient Name",?27,"SSN",?35,"Date/Time",?54,"Srce",?62,"Code",?68,"Description"
W !,DBLDASH
S X="[ '*' Indicates Deleted Outpatient Encounter for Transmission ]"
D CTR^SCRPIUT1(.X,IOM)
W !,X,!
Q
;
HDR1 ; Report header for no data found. Prints modified header.
;
W !?2,"Date: ",$$FDATE^VALM1($$DT^XLFDT),?((IOM/2)-22),"Incomplete Encounter Management Error Listing"
S X="Date Range: "_$$FMTE^XLFDT($P(SDDT,U))_" to "_$$FMTE^XLFDT($P(SDDT,U,2))
D CTR^SCRPIUT1(.X,IOM)
W !,X
S X="Selection Method by "_$$SELMTHD^SCRPI01(SDSEL1)_" then by "_$$SELMTHD^SCRPI01(SDSEL2)
D CTR^SCRPIUT1(.X,IOM)
W !,X,!!
W !?5,"No errors found"
D NEXTLEV(SDSEL1)
D NEXTLEV(SDSEL2)
Q
;
SELPAGE ; Print on last page the user parameters used for the report.
N SDIV,SDCLN,SDERR,SDPAT,SDDSS
;
I 'PAGE,IOST?1"C-".E W @IOF
I PAGE,IOST?1"C-".E D Q:$G(SCABORT)
. S DIR(0)="E" D ^DIR K DIR S SCABORT='+$G(Y)
. W @IOF
E D
. I PAGE W @IOF
;
S PAGE=PAGE+1
W !?2,"Date: ",$$FDATE^VALM1($$DT^XLFDT),?((IOM/2)-22),"Incomplete Encounter Management Error Listing",?(IOM-13),"Page: ",PAGE
S X="Report Selection Criteria"
D CTR^SCRPIUT1(X,IOM)
S X="Date Range: "_$$FMTE^XLFDT($P(SDDT,U))_" to "_$$FMTE^XLFDT($P(SDDT,U,2))
D CTR^SCRPIUT1(X,IOM)
;
W !!?10,"Divisions: ",$S(VAUTD:"All",1:"")
I 'VAUTD S SDIV="" F S SDIV=$O(VAUTD(SDIV)) Q:'SDIV W !?15,VAUTD(SDIV)
;
D NEXTLEV(SDSEL1)
D NEXTLEV(SDSEL2)
Q
;
NEXTLEV(SRT) ; Print out any sublevels of the user selection parameters
N SDITEM
;
I SRT["CLN" D
. W !!?10,"Clinics: ",$S(VAUTC:"All",1:"")
. I 'VAUTC S SDITEM="" F S SDITEM=$O(VAUTC(SDITEM)) Q:'SDITEM W !?15,VAUTC(SDITEM)
;
I SRT["PAT" D
. W !!?10,"Patients: ",$S(VAUTN:"All",1:"")
. I 'VAUTN S SDITEM="" F S SDITEM=$O(VAUTN(SDITEM)) Q:'SDITEM W !?15,VAUTN(SDITEM)
;
I SRT["ERR" D
. W !!?10,"Error Codes: ",$S(VAUER:"All",1:"")
. I 'VAUER S SDITEM="" F S SDITEM=$O(VAUER(SDITEM)) Q:'SDITEM W !?15,VAUER(SDITEM)," ",$E($P(^SD(409.76,SDITEM,1),U),1,60)
;
I SRT["DSS" D
. W !!?10,"Clinic Stop Codes: ",$S(VAUDS:"All",1:"")
. I 'VAUDS S SDITEM="" F S SDITEM=$O(VAUDS(SDITEM)) Q:'SDITEM W !?15,VAUDS(SDITEM)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSCRPI01A 5729 printed Nov 22, 2024@17:52:27 Page 2
SCRPI01A ;ALB/SCK - IEMM REPORT OF INCOMPLETE ENCOUNTERS PRINT ; 6/24/97
+1 ;;5.3;Scheduling;**66**;AUG 13, 1993
+2 QUIT
PRINT ; Begin printing report
+1 ; Variables
+2 ; PAGE - Page Number
+3 ; SDIV - Division Name
+4 ; SDCLN - Clinic Name
+5 ; SDNAME - Patient Name
+6 ; SDT - Encounter Date
+7 ; SCABORT - Abort report flag
+8 ;
+9 NEW DASH,DBLDASH,PAGE,SDIV,SDCLN,SDNAME,SDT,SCABORT,NONAME
+10 ;
+11 SET $PIECE(DASH,"-",IOM-1)=""
SET $PIECE(DBLDASH,"=",IOM-1)=""
+12 SET PAGE=0
SET SDIV=""
+13 ;
+14 IF '$DATA(^TMP("SCRPI ERR",$JOB))
DO HDR1
QUIT
+15 ;
+16 FOR
SET SDIV=$ORDER(^TMP("SCRPI ERR",$JOB,SDIV))
if SDIV']""
QUIT
Begin DoDot:1
+17 SET SDCLN=""
+18 FOR
SET SDCLN=$ORDER(^TMP("SCRPI ERR",$JOB,SDIV,SDCLN))
if SDCLN']""
QUIT
Begin DoDot:2
+19 DO HDR(SDIV,SDCLN)
+20 if $GET(SCABORT)
QUIT
+21 SET SDNAME=""
+22 FOR
SET SDNAME=$ORDER(^TMP("SCRPI ERR",$JOB,SDIV,SDCLN,SDNAME))
if SDNAME']""
QUIT
Begin DoDot:3
+23 SET SDT=""
SET NONAME=0
+24 FOR
SET SDT=$ORDER(^TMP("SCRPI ERR",$JOB,SDIV,SDCLN,SDNAME,SDT))
if 'SDT
QUIT
Begin DoDot:4
+25 SET SDER=""
+26 FOR
SET SDER=$ORDER(^TMP("SCRPI ERR",$JOB,SDIV,SDCLN,SDNAME,SDT,SDER))
if 'SDER
QUIT
DO LINE(^TMP("SCRPI ERR",$JOB,SDIV,SDCLN,SDNAME,SDT,SDER,0))
if $GET(SCABORT)
QUIT
End DoDot:4
if $GET(SCABORT)
QUIT
End DoDot:3
if $GET(SCABORT)
QUIT
End DoDot:2
if $GET(SCABORT)
QUIT
End DoDot:1
if $GET(SCABORT)
QUIT
+27 ;
+28 DO SELPAGE
+29 QUIT
+30 ;
LINE(SDTMP) ; Print formatted line of the report. Check if task has been stopped by user.
+1 ; Set abort flag to quit if stopped.
+2 ; Input
+3 ; SDTMP - formatted line to print
+4 ;
+5 ; Output
+6 ; SCABORT - 1 if user aborts report printing
+7 ;
+8 ; Variables
+9 ; SCERR - Error Code form #409.76
+10 ; SCERR1 - Error Description from #409.76
+11 ;
+12 NEW X,X1,X2,SCERR,SCERR1,DFN
+13 ;
+14 ; ** if task has been stopped, set abort flag and quit.
+15 IF $$S^%ZTLOAD
Begin DoDot:1
+16 SET SCABORT=1
+17 WRITE !!,"Report stopped by user"
End DoDot:1
QUIT
+18 ;
+19 IF $Y>(IOSL-5)
DO HDR(SDIV,SDCLN)
+20 ;
+21 ; ** Check that error is still around and has not been corrected.
+22 if '$GET(^SD(409.75,SDER,0))
QUIT
+23 SET SCERR=^SD(409.76,$PIECE(^SD(409.75,SDER,0),U,2),0)
+24 SET SCERR1=^SD(409.76,$PIECE(^SD(409.75,SDER,0),U,2),1)
+25 ;
+26 SET DFN=$PIECE(SDTMP,U)
+27 DO PID^VADPT6
+28 WRITE !,$SELECT('NONAME:$EXTRACT(SDNAME,1,25),1:" "),?27,$SELECT('NONAME:VA("BID"),1:" ")
+29 WRITE ?33,$SELECT($PIECE(SDTMP,U,3)]"":$PIECE(SDTMP,U,3),1:" ")," "
+30 WRITE $$FMTE^XLFDT(SDT,"2FP"),?55,$SELECT($PIECE(SCERR,U,2)="V":"VISTA",$PIECE(SCERR,U,2)="N":"NPCD ",1:"UNK "),?62,$PIECE(SCERR,U)
+31 ;
+32 ; ** Parse out error description to fit report. If description length >50, then
+33 ; call parse procedure to break description into two lines.
+34 SET X=$PIECE(SCERR1,U)
+35 IF $LENGTH(X)<50
Begin DoDot:1
+36 WRITE ?68,X
End DoDot:1
+37 IF '$TEST
Begin DoDot:1
+38 KILL X1,X2
+39 DO PARSE^SCRPIUT1(X,.X1,.X2,45,51)
+40 WRITE ?68,X1,!?68,X2
End DoDot:1
+41 SET NONAME=1
+42 KILL VA
+43 QUIT
+44 ;
HDR(SDIV,SDCLN) ; Print report header, if abort flag is set, then quit
+1 ; Input
+2 ; SDIV - Division Name
+3 ; SDCLN - Clinic Name
+4 ;
+5 ; Variables
+6 ; SDL - Print line
+7 ;
+8 NEW SDL,X
+9 ;
+10 IF 'PAGE
IF IOST?1"C-".E
WRITE @IOF
+11 IF PAGE
IF IOST?1"C-".E
Begin DoDot:1
+12 SET DIR(0)="E"
DO ^DIR
KILL DIR
SET SCABORT='+$GET(Y)
+13 WRITE @IOF
End DoDot:1
if $GET(SCABORT)
QUIT
+14 IF '$TEST
Begin DoDot:1
+15 IF PAGE
WRITE @IOF
End DoDot:1
+16 ;
+17 SET PAGE=PAGE+1
+18 WRITE !?2,"Date: ",$$FDATE^VALM1($$DT^XLFDT),?((IOM/2)-22),"Incomplete Encounter Management Error Listing",?(IOM-13),"Page: ",PAGE
+19 ;
+20 SET X="Division: "_$SELECT($GET(SDIV)]"":SDIV,1:" ---")
+21 DO CTR^SCRPIUT1(.X,IOM)
+22 WRITE !,X
+23 ;
+24 SET X="Clinic: "_$SELECT($GET(SDCLN)]"":SDCLN,1:" ---")
+25 DO CTR^SCRPIUT1(.X,IOM)
+26 WRITE !,X
+27 ;
+28 SET X="Date Range: "_$$FMTE^XLFDT($PIECE(SDDT,U))_" to "_$$FMTE^XLFDT($PIECE(SDDT,U,2))
+29 DO CTR^SCRPIUT1(.X,IOM)
+30 WRITE !,X
+31 ;
+32 SET X="Selection Method by "_$$SELMTHD^SCRPI01(SDSEL1)_" then by "_$$SELMTHD^SCRPI01(SDSEL2)
+33 DO CTR^SCRPIUT1(.X,IOM)
+34 WRITE !,X
+35 ;
+36 WRITE !!!,?35,"Encounter",?54,"Error",?62,"Error"
+37 WRITE !,"Patient Name",?27,"SSN",?35,"Date/Time",?54,"Srce",?62,"Code",?68,"Description"
+38 WRITE !,DBLDASH
+39 SET X="[ '*' Indicates Deleted Outpatient Encounter for Transmission ]"
+40 DO CTR^SCRPIUT1(.X,IOM)
+41 WRITE !,X,!
+42 QUIT
+43 ;
HDR1 ; Report header for no data found. Prints modified header.
+1 ;
+2 WRITE !?2,"Date: ",$$FDATE^VALM1($$DT^XLFDT),?((IOM/2)-22),"Incomplete Encounter Management Error Listing"
+3 SET X="Date Range: "_$$FMTE^XLFDT($PIECE(SDDT,U))_" to "_$$FMTE^XLFDT($PIECE(SDDT,U,2))
+4 DO CTR^SCRPIUT1(.X,IOM)
+5 WRITE !,X
+6 SET X="Selection Method by "_$$SELMTHD^SCRPI01(SDSEL1)_" then by "_$$SELMTHD^SCRPI01(SDSEL2)
+7 DO CTR^SCRPIUT1(.X,IOM)
+8 WRITE !,X,!!
+9 WRITE !?5,"No errors found"
+10 DO NEXTLEV(SDSEL1)
+11 DO NEXTLEV(SDSEL2)
+12 QUIT
+13 ;
SELPAGE ; Print on last page the user parameters used for the report.
+1 NEW SDIV,SDCLN,SDERR,SDPAT,SDDSS
+2 ;
+3 IF 'PAGE
IF IOST?1"C-".E
WRITE @IOF
+4 IF PAGE
IF IOST?1"C-".E
Begin DoDot:1
+5 SET DIR(0)="E"
DO ^DIR
KILL DIR
SET SCABORT='+$GET(Y)
+6 WRITE @IOF
End DoDot:1
if $GET(SCABORT)
QUIT
+7 IF '$TEST
Begin DoDot:1
+8 IF PAGE
WRITE @IOF
End DoDot:1
+9 ;
+10 SET PAGE=PAGE+1
+11 WRITE !?2,"Date: ",$$FDATE^VALM1($$DT^XLFDT),?((IOM/2)-22),"Incomplete Encounter Management Error Listing",?(IOM-13),"Page: ",PAGE
+12 SET X="Report Selection Criteria"
+13 DO CTR^SCRPIUT1(X,IOM)
+14 SET X="Date Range: "_$$FMTE^XLFDT($PIECE(SDDT,U))_" to "_$$FMTE^XLFDT($PIECE(SDDT,U,2))
+15 DO CTR^SCRPIUT1(X,IOM)
+16 ;
+17 WRITE !!?10,"Divisions: ",$SELECT(VAUTD:"All",1:"")
+18 IF 'VAUTD
SET SDIV=""
FOR
SET SDIV=$ORDER(VAUTD(SDIV))
if 'SDIV
QUIT
WRITE !?15,VAUTD(SDIV)
+19 ;
+20 DO NEXTLEV(SDSEL1)
+21 DO NEXTLEV(SDSEL2)
+22 QUIT
+23 ;
NEXTLEV(SRT) ; Print out any sublevels of the user selection parameters
+1 NEW SDITEM
+2 ;
+3 IF SRT["CLN"
Begin DoDot:1
+4 WRITE !!?10,"Clinics: ",$SELECT(VAUTC:"All",1:"")
+5 IF 'VAUTC
SET SDITEM=""
FOR
SET SDITEM=$ORDER(VAUTC(SDITEM))
if 'SDITEM
QUIT
WRITE !?15,VAUTC(SDITEM)
End DoDot:1
+6 ;
+7 IF SRT["PAT"
Begin DoDot:1
+8 WRITE !!?10,"Patients: ",$SELECT(VAUTN:"All",1:"")
+9 IF 'VAUTN
SET SDITEM=""
FOR
SET SDITEM=$ORDER(VAUTN(SDITEM))
if 'SDITEM
QUIT
WRITE !?15,VAUTN(SDITEM)
End DoDot:1
+10 ;
+11 IF SRT["ERR"
Begin DoDot:1
+12 WRITE !!?10,"Error Codes: ",$SELECT(VAUER:"All",1:"")
+13 IF 'VAUER
SET SDITEM=""
FOR
SET SDITEM=$ORDER(VAUER(SDITEM))
if 'SDITEM
QUIT
WRITE !?15,VAUER(SDITEM)," ",$EXTRACT($PIECE(^SD(409.76,SDITEM,1),U),1,60)
End DoDot:1
+14 ;
+15 IF SRT["DSS"
Begin DoDot:1
+16 WRITE !!?10,"Clinic Stop Codes: ",$SELECT(VAUDS:"All",1:"")
+17 IF 'VAUDS
SET SDITEM=""
FOR
SET SDITEM=$ORDER(VAUDS(SDITEM))
if 'SDITEM
QUIT
WRITE !?15,VAUDS(SDITEM)
End DoDot:1
+18 QUIT
