- DGMTOFA1 ;ALB/CAW - Output for Means/Copay Test List/Letter ; 8/24/92
- ;;5.3;Registration;**19,33,166,182,1015**;Aug 13, 1993;Build 21
- ;
- ;
- 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
- DGMTOFA1 ;ALB/CAW - Output for Means/Copay Test List/Letter ; 8/24/92
- +1 ;;5.3;Registration;**19,33,166,182,1015**;Aug 13, 1993;Build 21
- +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
