- DGMTOHD ;ALB/CAW - Hardship reivew date ;4/26/93
- ;;5.3;Registration;**1015**;Aug 13, 1993;Build 21
- ;
- ;
- EN ;
- I '$$RANGE^DGMTUTL G ENQ
- W !! S %ZIS="PMQ" D ^%ZIS I POP G ENQ
- I '$D(IO("Q")) D MAIN G ENQ
- S Y=$$QUE
- ENQ ;
- D:'$D(ZTQUEUED) ^%ZISC
- K DGBEG,DGC,DGEND,DG,DGLINE,DGPAGE,DGMT0,VA,VAERR Q
- ;
- MAIN ;
- S DG=0 U IO
- S DGPAGE=0,$P(DGLINE,"-",IOM+1)=""
- D HDR
- F S DG=$O(^DGMT(408.31,"AE",1,DG)) Q:'DG S DGMT0=^DGMT(408.31,DG,0) D
- .Q:$P(DGMT0,U,21)>DGEND!($P(DGMT0,U,21)<DGBEG)
- .D CHK
- .W !,?5,$P($G(^DPT($P(DGMT0,U,2),0)),U),?50,$$PID($P(DGMT0,U,2)),?65,$$FDATE^DGMTUTL($P(DGMT0,U,21))
- I '$D(DGMT0) W !,"No review dates found between selected date range."
- D CLOSE^DGMTUTL
- MAINQ Q
- ;
- PID(DFN) ;function to return pid
- ;INPUT - DFN
- ;OUTPUT - PID or UNKNOWN
- D PID^VADPT6
- Q $S(VA("PID")]"":VA("PID"),1:"UNKNOWN")
- ;
- HDR ; Header
- S DGC(1)="Hardship Review Date(s)"
- S DGC(2)="Date Range: "_$$FDATE^DGMTUTL(DGBEG)_" to "_$$FDATE^DGMTUTL(DGEND) D NOW^%DTC S DGC(3)="Run Date: "_$E($$FTIME^DGMTUTL(%),1,18)
- W:$E(IOST,1,2)["C-" @IOF F I=1:1:3 W !?(IOM-$L(DGC(I))/2),DGC(I)
- S DGPAGE=DGPAGE+1 W !?68,"Page ",DGPAGE,!,DGLINE,!
- W !?5,"Patient Name",?50," Patient ID ",?65,"Review Date"
- W !?5,"------------",?50,"------------",?65,"-----------",!
- 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 D HDR Q
- Q
- PAUSE ;
- W ! S DIR(0)="E" D ^DIR K DIR W !
- Q
- QUE() ; -- que job
- ; return: did job que [ 1|yes 0|no ]
- ;
- K ZTSK,IO("Q")
- S ZTDESC="Hardship Review Output",ZTRTN="MAIN^DGMTOHD"
- F X="DGBEG","DGEND" S ZTSAVE(X)=""
- D ^%ZTLOAD W:$D(ZTSK) " (Task: ",ZTSK,")"
- Q $D(ZTSK)
- DGMTOHD ;ALB/CAW - Hardship reivew date ;4/26/93
- +1 ;;5.3;Registration;**1015**;Aug 13, 1993;Build 21
- +2 ;
- +3 ;
- EN ;
- +1 IF '$$RANGE^DGMTUTL
- GOTO ENQ
- +2 WRITE !!
- SET %ZIS="PMQ"
- DO ^%ZIS
- IF POP
- GOTO ENQ
- +3 IF '$DATA(IO("Q"))
- DO MAIN
- GOTO ENQ
- +4 SET Y=$$QUE
- ENQ ;
- +1 IF '$DATA(ZTQUEUED)
- DO ^%ZISC
- +2 KILL DGBEG,DGC,DGEND,DG,DGLINE,DGPAGE,DGMT0,VA,VAERR
- QUIT
- +3 ;
- MAIN ;
- +1 SET DG=0
- USE IO
- +2 SET DGPAGE=0
- SET $PIECE(DGLINE,"-",IOM+1)=""
- +3 DO HDR
- +4 FOR
- SET DG=$ORDER(^DGMT(408.31,"AE",1,DG))
- IF 'DG
- QUIT
- SET DGMT0=^DGMT(408.31,DG,0)
- Begin DoDot:1
- +5 IF $PIECE(DGMT0,U,21)>DGEND!($PIECE(DGMT0,U,21)<DGBEG)
- QUIT
- +6 DO CHK
- +7 WRITE !,?5,$PIECE($GET(^DPT($PIECE(DGMT0,U,2),0)),U),?50,$$PID($PIECE(DGMT0,U,2)),?65,$$FDATE^DGMTUTL($PIECE(DGMT0,U,21))
- End DoDot:1
- +8 IF '$DATA(DGMT0)
- WRITE !,"No review dates found between selected date range."
- +9 DO CLOSE^DGMTUTL
- MAINQ QUIT
- +1 ;
- PID(DFN) ;function to return pid
- +1 ;INPUT - DFN
- +2 ;OUTPUT - PID or UNKNOWN
- +3 DO PID^VADPT6
- +4 QUIT $SELECT(VA("PID")]"":VA("PID"),1:"UNKNOWN")
- +5 ;
- HDR ; Header
- +1 SET DGC(1)="Hardship Review Date(s)"
- +2 SET DGC(2)="Date Range: "_$$FDATE^DGMTUTL(DGBEG)_" to "_$$FDATE^DGMTUTL(DGEND)
- DO NOW^%DTC
- SET DGC(3)="Run Date: "_$EXTRACT($$FTIME^DGMTUTL(%),1,18)
- +3 IF $EXTRACT(IOST,1,2)["C-"
- WRITE @IOF
- FOR I=1:1:3
- WRITE !?(IOM-$LENGTH(DGC(I))/2),DGC(I)
- +4 SET DGPAGE=DGPAGE+1
- WRITE !?68,"Page ",DGPAGE,!,DGLINE,!
- +5 WRITE !?5,"Patient Name",?50," Patient ID ",?65,"Review Date"
- +6 WRITE !?5,"------------",?50,"------------",?65,"-----------",!
- +7 QUIT
- 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
- DO HDR
- QUIT
- +3 QUIT
- PAUSE ;
- +1 WRITE !
- SET DIR(0)="E"
- DO ^DIR
- KILL DIR
- WRITE !
- +2 QUIT
- QUE() ; -- que job
- +1 ; return: did job que [ 1|yes 0|no ]
- +2 ;
- +3 KILL ZTSK,IO("Q")
- +4 SET ZTDESC="Hardship Review Output"
- SET ZTRTN="MAIN^DGMTOHD"
- +5 FOR X="DGBEG","DGEND"
- SET ZTSAVE(X)=""
- +6 DO ^%ZTLOAD
- IF $DATA(ZTSK)
- WRITE " (Task: ",ZTSK,")"
- +7 QUIT $DATA(ZTSK)
