- SDAMOLP ;ALB/CAW - Retroactive Encounter List (Print); 4/15/92 ; 03 Feb 99 4:20 PM
- ;;5.3;Scheduling;**132,176**;Aug 13, 1993
- ;
- BLD ; Build info from ^TMP global
- ;
- ; -- check if user has asked to stop job
- IF $$S^%ZTLOAD("Printing Retroactive Report...") S (SDSTOP,ZTSTOP)=1 G BLDQ
- ;
- S (SDDV,SDSC,SDAD,SDDFN)="",(SDPAGE,SDSTOP)=0,SDFST=21,SDSEC=50,SDFLEN=14,SDSLEN=30,SDCNT=0,SDMORE=1
- S $P(SDASH,"-",IOM+1)=""
- U IO
- I '$D(^TMP("SDRAL",$J)) D HDR W !,SDASH,!!,"No Encounters found for selected date range." G BLDQ
- ;
- D DV
- ;
- IF SDSTOP G BLDQ
- ;
- IF $G(SDCNT) D TOTAL
- ;
- BLDQ ; -- send message that job finished or stopped
- N X
- S X=$S('SDSTOP:"Retroactive Report Successfully Completed",1:"Retroactive Report Stopped By User")
- S X=$$S^%ZTLOAD(X)
- Q
- ;
- ; SDDV=Division, SDSC=Stop Code, SDAD=Encounter Date/Time, SDDFN=Patient
- ;
- DV F S SDDV=$O(^TMP("SDRAL",$J,SDDV)) Q:SDDV="" D SC Q:SDSTOP
- Q
- SC F S SDSC=$O(^TMP("SDRAL",$J,SDDV,SDSC)) Q:SDSC="" D HDR,AD Q:SDSTOP
- Q
- AD F S SDAD=$O(^TMP("SDRAL",$J,SDDV,SDSC,SDAD)) Q:'SDAD D DFN Q:SDSTOP
- Q
- DFN F S SDDFN=$O(^TMP("SDRAL",$J,SDDV,SDSC,SDAD,SDDFN)) Q:'SDDFN S SDATA=^(SDDFN) S DFN=SDDFN D PID^VADPT6 D INFO Q:SDSTOP S SDCNT=$G(SDCNT)+1
- Q
- ;
- TOTAL ;
- W !!!,"Total Encounters: ",SDCNT
- Q
- INFO ; Encounter Date/Time and Patient
- ;
- W !,SDASH
- W !,"Encounter Date/Time:",?SDFST,$$FDTTM^VALM1(SDAD),?41,"Patient:",?SDSEC,$P(^DPT(SDDFN,0),U)
- ;
- ; Date Encounter Entered and ID
- W !,?7,"Date Entered:",?SDFST,$$FDTTM^VALM1($P(SDATA,U,2)),?46,"ID:",?SDSEC,VA("PID")
- ;
- ; Date Transmitted and Type
- W !,?3,"Close-Out Date :",?SDFST,$$FDTTM^VALM1($P(SDATA,U,5)),?44,"Type:",?SDSEC,$P(SDATA,U,4)
- ;
- ; User
- W !,?13,"Clinic:",?SDFST,$S($P(SDATA,U,6)=0:"",1:$P(SDATA,U,6)),?44,"User:",?SDSEC,$P($G(^VA(200,+$P(SDATA,U,3),0),"UNKNOWN"),U)
- ;
- S SDMORE=$S('$O(^TMP("SDRAL",$J,SDDV,SDSC,SDAD)):0,1:1)
- D CHK
- ;
- ; -- check if user has asked to stop job
- IF $$S^%ZTLOAD() S (SDSTOP,ZTSTOP)=1
- Q
- ;
- HDR ; Header
- ;
- S SDPAGE=SDPAGE+1
- I $E(IOST,1,2)="C-",'SDMORE S SDMORE=1 D PAUSE^VALM1 I 'Y S SDSTOP=1 Q
- W @IOF,"Retroactive Encounter List",?70,"Page: "_SDPAGE
- W !,?3,"Date Range: "_$$FDATE^VALM1(SDBD)_" to "_$$FDATE^VALM1(SDED) D NOW^%DTC W ?51,"Run Date: "_$E($$FTIME^VALM1(%),1,18) Q:'$D(^TMP("SDRAL",$J))
- W !,?5,"Division: "_$P($G(^DG(40.8,SDDV,0)),U),?44,"Close-Out Check: ",$S(SDNPDB=1:"DATABASE UPDATE ONLY",1:"WORKLOAD CREDIT")
- W !,?4,"Stop Code: "_SDSC,?44,"Visit Selection: "_$S(SDSEL=1:"STOP CODE",1:"CLINIC")
- Q
- ;
- CHK ;Check to pause on screen
- I $E(IOST,1,2)="C-",($Y+7)>IOSL D
- . D PAUSE^VALM1 S SDY=Y
- . IF SDMORE,SDY D HDR
- . S:'SDMORE SDMORE=1
- . IF 'SDY S SDSTOP=1
- I $E(IOST,1,2)="P-",($Y+6)>IOSL,SDMORE D HDR Q
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDAMOLP 2774 printed Jan 18, 2025@03:49:09 Page 2
- SDAMOLP ;ALB/CAW - Retroactive Encounter List (Print); 4/15/92 ; 03 Feb 99 4:20 PM
- +1 ;;5.3;Scheduling;**132,176**;Aug 13, 1993
- +2 ;
- BLD ; Build info from ^TMP global
- +1 ;
- +2 ; -- check if user has asked to stop job
- +3 IF $$S^%ZTLOAD("Printing Retroactive Report...")
- SET (SDSTOP,ZTSTOP)=1
- GOTO BLDQ
- +4 ;
- +5 SET (SDDV,SDSC,SDAD,SDDFN)=""
- SET (SDPAGE,SDSTOP)=0
- SET SDFST=21
- SET SDSEC=50
- SET SDFLEN=14
- SET SDSLEN=30
- SET SDCNT=0
- SET SDMORE=1
- +6 SET $PIECE(SDASH,"-",IOM+1)=""
- +7 USE IO
- +8 IF '$DATA(^TMP("SDRAL",$JOB))
- DO HDR
- WRITE !,SDASH,!!,"No Encounters found for selected date range."
- GOTO BLDQ
- +9 ;
- +10 DO DV
- +11 ;
- +12 IF SDSTOP
- GOTO BLDQ
- +13 ;
- +14 IF $GET(SDCNT)
- DO TOTAL
- +15 ;
- BLDQ ; -- send message that job finished or stopped
- +1 NEW X
- +2 SET X=$SELECT('SDSTOP:"Retroactive Report Successfully Completed",1:"Retroactive Report Stopped By User")
- +3 SET X=$$S^%ZTLOAD(X)
- +4 QUIT
- +5 ;
- +6 ; SDDV=Division, SDSC=Stop Code, SDAD=Encounter Date/Time, SDDFN=Patient
- +7 ;
- DV FOR
- SET SDDV=$ORDER(^TMP("SDRAL",$JOB,SDDV))
- if SDDV=""
- QUIT
- DO SC
- if SDSTOP
- QUIT
- +1 QUIT
- SC FOR
- SET SDSC=$ORDER(^TMP("SDRAL",$JOB,SDDV,SDSC))
- if SDSC=""
- QUIT
- DO HDR
- DO AD
- if SDSTOP
- QUIT
- +1 QUIT
- AD FOR
- SET SDAD=$ORDER(^TMP("SDRAL",$JOB,SDDV,SDSC,SDAD))
- if 'SDAD
- QUIT
- DO DFN
- if SDSTOP
- QUIT
- +1 QUIT
- DFN FOR
- SET SDDFN=$ORDER(^TMP("SDRAL",$JOB,SDDV,SDSC,SDAD,SDDFN))
- if 'SDDFN
- QUIT
- SET SDATA=^(SDDFN)
- SET DFN=SDDFN
- DO PID^VADPT6
- DO INFO
- if SDSTOP
- QUIT
- SET SDCNT=$GET(SDCNT)+1
- +1 QUIT
- +2 ;
- TOTAL ;
- +1 WRITE !!!,"Total Encounters: ",SDCNT
- +2 QUIT
- INFO ; Encounter Date/Time and Patient
- +1 ;
- +2 WRITE !,SDASH
- +3 WRITE !,"Encounter Date/Time:",?SDFST,$$FDTTM^VALM1(SDAD),?41,"Patient:",?SDSEC,$PIECE(^DPT(SDDFN,0),U)
- +4 ;
- +5 ; Date Encounter Entered and ID
- +6 WRITE !,?7,"Date Entered:",?SDFST,$$FDTTM^VALM1($PIECE(SDATA,U,2)),?46,"ID:",?SDSEC,VA("PID")
- +7 ;
- +8 ; Date Transmitted and Type
- +9 WRITE !,?3,"Close-Out Date :",?SDFST,$$FDTTM^VALM1($PIECE(SDATA,U,5)),?44,"Type:",?SDSEC,$PIECE(SDATA,U,4)
- +10 ;
- +11 ; User
- +12 WRITE !,?13,"Clinic:",?SDFST,$SELECT($PIECE(SDATA,U,6)=0:"",1:$PIECE(SDATA,U,6)),?44,"User:",?SDSEC,$PIECE($GET(^VA(200,+$PIECE(SDATA,U,3),0),"UNKNOWN"),U)
- +13 ;
- +14 SET SDMORE=$SELECT('$ORDER(^TMP("SDRAL",$JOB,SDDV,SDSC,SDAD)):0,1:1)
- +15 DO CHK
- +16 ;
- +17 ; -- check if user has asked to stop job
- +18 IF $$S^%ZTLOAD()
- SET (SDSTOP,ZTSTOP)=1
- +19 QUIT
- +20 ;
- HDR ; Header
- +1 ;
- +2 SET SDPAGE=SDPAGE+1
- +3 IF $EXTRACT(IOST,1,2)="C-"
- IF 'SDMORE
- SET SDMORE=1
- DO PAUSE^VALM1
- IF 'Y
- SET SDSTOP=1
- QUIT
- +4 WRITE @IOF,"Retroactive Encounter List",?70,"Page: "_SDPAGE
- +5 WRITE !,?3,"Date Range: "_$$FDATE^VALM1(SDBD)_" to "_$$FDATE^VALM1(SDED)
- DO NOW^%DTC
- WRITE ?51,"Run Date: "_$EXTRACT($$FTIME^VALM1(%),1,18)
- if '$DATA(^TMP("SDRAL",$JOB))
- QUIT
- +6 WRITE !,?5,"Division: "_$PIECE($GET(^DG(40.8,SDDV,0)),U),?44,"Close-Out Check: ",$SELECT(SDNPDB=1:"DATABASE UPDATE ONLY",1:"WORKLOAD CREDIT")
- +7 WRITE !,?4,"Stop Code: "_SDSC,?44,"Visit Selection: "_$SELECT(SDSEL=1:"STOP CODE",1:"CLINIC")
- +8 QUIT
- +9 ;
- CHK ;Check to pause on screen
- +1 IF $EXTRACT(IOST,1,2)="C-"
- IF ($Y+7)>IOSL
- Begin DoDot:1
- +2 DO PAUSE^VALM1
- SET SDY=Y
- +3 IF SDMORE
- IF SDY
- DO HDR
- +4 if 'SDMORE
- SET SDMORE=1
- +5 IF 'SDY
- SET SDSTOP=1
- End DoDot:1
- +6 IF $EXTRACT(IOST,1,2)="P-"
- IF ($Y+6)>IOSL
- IF SDMORE
- DO HDR
- QUIT
- +7 QUIT