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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFHORX2 1376 printed Apr 09, 2024@20:56:35 Page 2
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
