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 Sep 23, 2025@20:24:24 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
