FHORX2.m

FHORX2 ; HISC/REL,RTK - List Patient Events ;8/2/94  10:07

 ;;5.5;DIETETICS;;Jan 28, 2005

 S FHALL=1 D ^FHOMDPA

 I 'DFN,'IEN200 G KIL

 G:FHDFN="" KIL D NOW^%DTC S DT=%\1

 I '$D(^FH(119.8,"AP",FHDFN)) W !!,"No Dietetic Events on File." G FHORX2

 D DT G:'SDT!('EDT) FHORX2 S EDT=EDT+.3

 K IOP S %ZIS="MQ",%ZIS("B")="HOME" W ! D ^%ZIS K %ZIS,IOP G:POP KIL

 I $D(IO("Q")) S FHPGM="Q1^FHORX2",FHLST="FHDFN^DFN^SDT^EDT" D EN2^FH G KIL

 U IO D Q1 D ^%ZISC K %ZIS,IOP G FHORX2

Q1 ; Process List

 D HDR F KK=SDT-.1:0 S KK=$O(^FH(119.8,"AP",FHDFN,KK)) Q:KK>EDT!(KK<1)  F DA=0:0 S DA=$O(^FH(119.8,"AP",FHDFN,KK,DA)) Q:DA<1  D ^FHORX3

 G KIL

HDR I DFN S X="Dietetic Events for "_$P($G(^DPT(DFN,0)),"^",1) W:$E(IOST,1,2)="C-" @IOF W !?(80-$L(X)\2),X

 I 'DFN S X="Dietetic Events for "_$P($G(^VA(200,IEN200,0)),"^",1) W:$E(IOST,1,2)="C-" @IOF W !?(80-$L(X)\2),X

 W !!?26,"From " S D1=SDT D DTP^FHORX3 W " to " S D1=EDT\1 D DTP^FHORX3 W !

 Q

DT ; Get From/To Dates

D1 S (SDT,EDT)=0,%DT="AEPX",%DT("A")="Starting Date: " W ! D ^%DT S:$D(DTOUT) X="^" G D3:U[X,D1:Y<1 S SDT=+Y

 I SDT>DT W *7,"  [Cannot Start after Today!] " G D1

D2 S EDT=0,%DT="AEPX",%DT("A")=" Ending Date: ",%DT("B")="T" D ^%DT S:$D(DTOUT) X="^" G D3:U[X,D2:Y<1 S EDT=+Y

 I EDT>DT W *7,"  [Cannot End after Today!] " G D2

 I EDT<SDT W *7,"  [End before Start?] " G D1

D3 K %DT Q

KIL G KILL^XUSCLEAN

FHORX2    ; HISC/REL,RTK - List Patient Events ;8/2/94  10:07

 +1       ;;5.5;DIETETICS;;Jan 28, 2005

 +2        SET FHALL=1

           DO ^FHOMDPA

 +3        IF 'DFN

               IF 'IEN200

                   GOTO KIL

 +4        IF FHDFN=""

               GOTO KIL

           DO NOW^%DTC

           SET DT=%\1

 +5        IF '$DATA(^FH(119.8,"AP",FHDFN))

               WRITE !!,"No Dietetic Events on File."

               GOTO FHORX2

 +6        DO DT

           IF 'SDT!('EDT)

               GOTO FHORX2

           SET EDT=EDT+.3

 +7        KILL IOP

           SET %ZIS="MQ"

           SET %ZIS("B")="HOME"

           WRITE !

           DO ^%ZIS

           KILL %ZIS,IOP

           IF POP

               GOTO KIL

 +8        IF $DATA(IO("Q"))

               SET FHPGM="Q1^FHORX2"

               SET FHLST="FHDFN^DFN^SDT^EDT"

               DO EN2^FH

               GOTO KIL

 +9        USE IO

           DO Q1

           DO ^%ZISC

           KILL %ZIS,IOP

           GOTO FHORX2

Q1        ; Process List

 +1        DO HDR

           FOR KK=SDT-.1:0

               SET KK=$ORDER(^FH(119.8,"AP",FHDFN,KK))

               IF KK>EDT!(KK<1)

                   QUIT 

               FOR DA=0:0

                   SET DA=$ORDER(^FH(119.8,"AP",FHDFN,KK,DA))

                   IF DA<1

                       QUIT 

                   DO ^FHORX3

 +2        GOTO KIL

HDR        IF DFN

               SET X="Dietetic Events for "_$PIECE($GET(^DPT(DFN,0)),"^",1)

               IF $EXTRACT(IOST,1,2)="C-"

                   WRITE @IOF

               WRITE !?(80-$LENGTH(X)\2),X

 +1        IF 'DFN

               SET X="Dietetic Events for "_$PIECE($GET(^VA(200,IEN200,0)),"^",1)

               IF $EXTRACT(IOST,1,2)="C-"

                   WRITE @IOF

               WRITE !?(80-$LENGTH(X)\2),X

 +2        WRITE !!?26,"From "

           SET D1=SDT

           DO DTP^FHORX3

           WRITE " to "

           SET D1=EDT\1

           DO DTP^FHORX3

           WRITE !

 +3        QUIT 

DT        ; Get From/To Dates

D1         SET (SDT,EDT)=0

           SET %DT="AEPX"

           SET %DT("A")="Starting Date: "

           WRITE !

           DO ^%DT

           IF $DATA(DTOUT)

               SET X="^"

           IF U[X

               GOTO D3

           IF Y<1

               GOTO D1

           SET SDT=+Y

 +1        IF SDT>DT

               WRITE *7,"  [Cannot Start after Today!] "

               GOTO D1

D2         SET EDT=0

           SET %DT="AEPX"

           SET %DT("A")=" Ending Date: "

           SET %DT("B")="T"

           DO ^%DT

           IF $DATA(DTOUT)

               SET X="^"

           IF U[X

               GOTO D3

           IF Y<1

               GOTO D2

           SET EDT=+Y

 +1        IF EDT>DT

               WRITE *7,"  [Cannot End after Today!] "

               GOTO D2

 +2        IF EDT<SDT

               WRITE *7,"  [End before Start?] "

               GOTO D1

D3         KILL %DT

           QUIT 

KIL        GOTO KILL^XUSCLEAN