DGMTOHD.m

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)