- SCRPI01A ;ALB/SCK - IEMM REPORT OF INCOMPLETE ENCOUNTERS PRINT ; 6/24/97
- ;;5.3;Scheduling;**66,1015**;AUG 13, 1993;Build 21
- 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
- SCRPI01A ;ALB/SCK - IEMM REPORT OF INCOMPLETE ENCOUNTERS PRINT ; 6/24/97
- +1 ;;5.3;Scheduling;**66,1015**;AUG 13, 1993;Build 21
- +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