- 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 Feb 18, 2025@23:20:29 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
