DGMTOFA1 ;ALB/CAW - Output for Means/Copay Test List/Letter ; 8/24/92
;;5.3;Registration;**19,33,166,182**;Aug 13, 1993
;
;
EN S (DGTMP,DGTMP1,DGTMP2,DGTMP3)="",(DGSTOP,DGPAGE)=0,$P(DGLINE,"-",IOM+1)=""
I '$D(^TMP("DGMTO",$J)) D HDR W !!,"THERE ARE NO PATIENTS THAT WILL NEED A "_$S(DGMTYPT=1:"MEANS",1:"COPAY")_" TEST AT THEIR NEXT APPOINTMENT FOR THIS DATE RANGE" Q
F S DGTMP=$O(^TMP("DGMTO",$J,DGTMP)) Q:'DGTMP!(DGSTOP) F S DGTMP1=$O(^TMP("DGMTO",$J,DGTMP,DGTMP1)) Q:DGTMP1=""!(DGSTOP) D HDR D Q:DGSTOP W:$E(IOST,1)="P" @IOF I $E(IOST,1,2)="C-" D PAUSE G ENQ:'Y
.F S DGTMP2=$O(^TMP("DGMTO",$J,DGTMP,DGTMP1,DGTMP2)) Q:DGTMP2=""!(DGSTOP) F S DGTMP3=$O(^TMP("DGMTO",$J,DGTMP,DGTMP1,DGTMP2,DGTMP3)) Q:'DGTMP3!(DGSTOP) S DGINFO=^(DGTMP3) D Q:DGSTOP
..S:$P(DGINFO,U,5)="P" $P(DGINFO,U,4)="PEND. ADJ." S DFN=+DGINFO D PID^VADPT
..S SDAPTYP=$P($G(^SD(409.1,+$P(DGINFO,U,6),0)),U,4)
..S DGNXTMT=$P(DGINFO,U,7),DGNXTMT=$$FDATE^DGMTUTL($E(DGNXTMT,1,12))
..W !,$E(DGTMP2,1,15),?17,VA("PID"),?29,$$FDATE^DGMTUTL($E(DGTMP3,1,12)),?46,SDAPTYP,?50,$P(DGINFO,U,4),?59,$S($P(DGINFO,U,2)="":"",1:$$FDATE^DGMTUTL($P(DGINFO,U,3)))
..W ?70,DGNXTMT
..D CHK
D LETTER
ENQ Q
;
HDR ; Header
U IO W:$E(IOST,1,2)["C-" @IOF
S DGPAGE=DGPAGE+1
I DGMTYPT=1 W "Patients Requiring Means Test At Next Appointment"
I DGMTYPT=2 W "Copay Exemptions That Will Need Updating At Next Appointment"
W ?70,"Page: "_DGPAGE
W !,"Date Range: "_$$FDATE^DGMTUTL(DGBEG)_" to "_$$FDATE^DGMTUTL($P(DGEND,".")) D NOW^%DTC W ?51,"Run Date: "_$E($$FDATE^DGMTUTL(%),1,20)
I $D(^TMP("DGMTO",$J)) D
.W !!,"","CLINIC: "_DGTMP1,?50,"DIVISION: "_$P($$SITE^VASITE(DGBEG,DGTMP),U,2)
.W !!?46,"APPT",?59,"INCOMPLETE",?70,"FUTURE"
.W !,"PATIENT",?17,"PATIENT ID",?29,"APPT DATE/TIME",?46,"TYPE",?51,"STATUS",?59,"TEST",?70," TEST"
W !,DGLINE
Q
;
CHK ;Check to pause on screen
I ($Y+5)>IOSL,$E(IOST,1,2)="C-" D PAUSE S DGP=Y D:DGP HDR I 'DGP S DGSTOP=1 Q
I $E(IOST,1,2)="P-",($Y+5)>IOSL W @IOF D HDR Q
Q
PAUSE ;
W ! S DIR(0)="E" D ^DIR K DIR W !
Q
;
LETTER ; Check and print letter
I $D(DGYN),DGYN S (DGTMP,DFN)="" D
.;F S DGTMP=$O(^TMP("DGMTL",$J,DGTMP)) Q:DGTMP="" F S DFN=$O(^TMP("DGMTL",$J,DGTMP,DFN)) Q:'DFN D CHECK^DGMTLTR
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGMTOFA1 2261 printed Oct 16, 2024@18:45:42 Page 2
DGMTOFA1 ;ALB/CAW - Output for Means/Copay Test List/Letter ; 8/24/92
+1 ;;5.3;Registration;**19,33,166,182**;Aug 13, 1993
+2 ;
+3 ;
EN SET (DGTMP,DGTMP1,DGTMP2,DGTMP3)=""
SET (DGSTOP,DGPAGE)=0
SET $PIECE(DGLINE,"-",IOM+1)=""
+1 IF '$DATA(^TMP("DGMTO",$JOB))
DO HDR
WRITE !!,"THERE ARE NO PATIENTS THAT WILL NEED A "_$SELECT(DGMTYPT=1:"MEANS",1:"COPAY")_" TEST AT THEIR NEXT APPOINTMENT FOR THIS DATE RANGE"
QUIT
+2 FOR
SET DGTMP=$ORDER(^TMP("DGMTO",$JOB,DGTMP))
if 'DGTMP!(DGSTOP)
QUIT
FOR
SET DGTMP1=$ORDER(^TMP("DGMTO",$JOB,DGTMP,DGTMP1))
if DGTMP1=""!(DGSTOP)
QUIT
DO HDR
Begin DoDot:1
+3 FOR
SET DGTMP2=$ORDER(^TMP("DGMTO",$JOB,DGTMP,DGTMP1,DGTMP2))
if DGTMP2=""!(DGSTOP)
QUIT
FOR
SET DGTMP3=$ORDER(^TMP("DGMTO",$JOB,DGTMP,DGTMP1,DGTMP2,DGTMP3))
if 'DGTMP3!(DGSTOP)
QUIT
SET DGINFO=^(DGTMP3)
Begin DoDot:2
+4 if $PIECE(DGINFO,U,5)="P"
SET $PIECE(DGINFO,U,4)="PEND. ADJ."
SET DFN=+DGINFO
DO PID^VADPT
+5 SET SDAPTYP=$PIECE($GET(^SD(409.1,+$PIECE(DGINFO,U,6),0)),U,4)
+6 SET DGNXTMT=$PIECE(DGINFO,U,7)
SET DGNXTMT=$$FDATE^DGMTUTL($EXTRACT(DGNXTMT,1,12))
+7 WRITE !,$EXTRACT(DGTMP2,1,15),?17,VA("PID"),?29,$$FDATE^DGMTUTL($EXTRACT(DGTMP3,1,12)),?46,SDAPTYP,?50,$PIECE(DGINFO,U,4),?59,$SELECT($PIECE(DGINFO,U,2)="":"",1:$$FDATE^DGMTUTL($PIECE(DGINFO,U,3)))
+8 WRITE ?70,DGNXTMT
+9 DO CHK
End DoDot:2
if DGSTOP
QUIT
End DoDot:1
if DGSTOP
QUIT
if $EXTRACT(IOST,1)="P"
WRITE @IOF
IF $EXTRACT(IOST,1,2)="C-"
DO PAUSE
if 'Y
GOTO ENQ
+10 DO LETTER
ENQ QUIT
+1 ;
HDR ; Header
+1 USE IO
if $EXTRACT(IOST,1,2)["C-"
WRITE @IOF
+2 SET DGPAGE=DGPAGE+1
+3 IF DGMTYPT=1
WRITE "Patients Requiring Means Test At Next Appointment"
+4 IF DGMTYPT=2
WRITE "Copay Exemptions That Will Need Updating At Next Appointment"
+5 WRITE ?70,"Page: "_DGPAGE
+6 WRITE !,"Date Range: "_$$FDATE^DGMTUTL(DGBEG)_" to "_$$FDATE^DGMTUTL($PIECE(DGEND,"."))
DO NOW^%DTC
WRITE ?51,"Run Date: "_$EXTRACT($$FDATE^DGMTUTL(%),1,20)
+7 IF $DATA(^TMP("DGMTO",$JOB))
Begin DoDot:1
+8 WRITE !!,"","CLINIC: "_DGTMP1,?50,"DIVISION: "_$PIECE($$SITE^VASITE(DGBEG,DGTMP),U,2)
+9 WRITE !!?46,"APPT",?59,"INCOMPLETE",?70,"FUTURE"
+10 WRITE !,"PATIENT",?17,"PATIENT ID",?29,"APPT DATE/TIME",?46,"TYPE",?51,"STATUS",?59,"TEST",?70," TEST"
End DoDot:1
+11 WRITE !,DGLINE
+12 QUIT
+13 ;
CHK ;Check to pause on screen
+1 IF ($Y+5)>IOSL
IF $EXTRACT(IOST,1,2)="C-"
DO PAUSE
SET DGP=Y
if DGP
DO HDR
IF 'DGP
SET DGSTOP=1
QUIT
+2 IF $EXTRACT(IOST,1,2)="P-"
IF ($Y+5)>IOSL
WRITE @IOF
DO HDR
QUIT
+3 QUIT
PAUSE ;
+1 WRITE !
SET DIR(0)="E"
DO ^DIR
KILL DIR
WRITE !
+2 QUIT
+3 ;
LETTER ; Check and print letter
+1 IF $DATA(DGYN)
IF DGYN
SET (DGTMP,DFN)=""
Begin DoDot:1
+2 ;F S DGTMP=$O(^TMP("DGMTL",$J,DGTMP)) Q:DGTMP="" F S DFN=$O(^TMP("DGMTL",$J,DGTMP,DFN)) Q:'DFN D CHECK^DGMTLTR
End DoDot:1
+3 QUIT
