FHMNINQ ;Hines OIFO/JT,RTK - Dietetics Monitor Inquiry ;07/26/01 09:53
;;5.5;DIETETICS;;Jan 28, 2005
;
DATE W ! K DIC S DIC="^DPT(",DIC(0)="AEQM" D ^DIC Q:Y<0 S DFN=+Y K DIC
I $O(^DGPM("APTT1",DFN,""))="" W !,"NO ADMISSIONS FOR THIS PATIENT!" H 2 Q
W !,"This patient has the following admissions:",!
S FHINDX=0 F FHI=0:0 S FHI=$O(^DGPM("APTT1",DFN,FHI)) Q:FHI'>0 D
.S FHINDX=FHINDX+1
.S FHLST(FHINDX)=FHI S Y=FHI D DD^%DT W !,FHINDX,?5,Y
.Q
D SELADM I '$G(FHADM) D EX Q
D DEV,EX Q
;
EN ;
S FHZ115="P"_DFN D CHECK^FHOMDPA I FHDFN="" Q
S PG=0,EX="" D NOW^%DTC S Y=X D DD^%DT S FHNDT=Y D HDR
S FLG=0 I '$O(^FHPT(FHDFN,"A",FHADM,"MO",0)) D
.W "NO MONITORS FOR THIS PATIENT" S FLG=1 Q
Q:FLG
S J=0 F S J=$O(^FHPT(FHDFN,"A",FHADM,"MO",J)) Q:'J!(EX=U) D
.I $Y>(IOSL-4) D PG I EX=U Q
.W !!?3,$P(^FHPT(FHDFN,"A",FHADM,"MO",J,0),U,1)
.W !?6,"Entered: " S Y=$P(^(0),U,2) X ^DD("DD") W Y K Y
.S Y=$P(^FHPT(FHDFN,"A",FHADM,"MO",J,0),U,5) Q:'Y
.W ?40,"Cleared: " X ^DD("DD") W Y Q
I IOST?1"C".E,EX'=U W ! K DIR S DIR(0)="E" D ^DIR
EX K %DT,X,Y,FHI,FHINDX,FHLST,FHADM,FHNDT,FHDFN,DFN,SSN,FLG,J
Q
DEV ;device and queue info
W ! K %ZIS,IOP S %ZIS="Q" D ^%ZIS Q:POP
I '$D(IO("Q")) U IO D EN,^%ZISC Q
S ZTRTN="EN^FHMNINQ"
S ZTSAVE("FHI")="",ZTSAVE("FHINDX")="",ZTSAVE("FHNDT")=""
S ZTSAVE("FHLST")="",ZTSAVE("FHADM")=""
S ZTSAVE("DFN")="",ZTSAVE("FHDFN")=""
S ZTDESC="Dietetics Monitor Inquiry" D ^%ZTLOAD
D ^%ZISC K %ZIS,IOP
Q
SELADM ;
K DIR W ! S DIR(0)="N"
S DIR("A")="Select Admission Date for this Patient"
D ^DIR
Q:$D(DIRUT)
I Y<1!(Y>FHINDX) W !!,"Response must be no less than 1 and no greater than ",FHINDX,"." D SELADM Q
S FHI=FHLST(Y),FHADM=$O(^DGPM("APTT1",DFN,FHI,0))
Q
PG ;
I IOST?1"C".E W ! K DIR S DIR(0)="E" D ^DIR I 'Y S EX=U Q
D HDR Q
HDR ;
W:$Y @IOF W !,FHNDT,?60,"Page: " S PG=PG+1 W PG,!!
W $E($P(^DPT(DFN,0),U,1),1,28) S SSN=$P(^(0),U,9)
W ?30,$E(SSN,1,3)_"-"_$E(SSN,4,5)_"-"_$E(SSN,6,9)
W ?44,"Admission Date: " S Y=FHI X ^DD("DD") W Y
W ! F Z=1:1:79 W "="
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFHMNINQ 2067 printed Apr 09, 2024@21:01:02 Page 2
FHMNINQ ;Hines OIFO/JT,RTK - Dietetics Monitor Inquiry ;07/26/01 09:53
+1 ;;5.5;DIETETICS;;Jan 28, 2005
+2 ;
DATE WRITE !
KILL DIC
SET DIC="^DPT("
SET DIC(0)="AEQM"
DO ^DIC
if Y<0
QUIT
SET DFN=+Y
KILL DIC
+1 IF $ORDER(^DGPM("APTT1",DFN,""))=""
WRITE !,"NO ADMISSIONS FOR THIS PATIENT!"
HANG 2
QUIT
+2 WRITE !,"This patient has the following admissions:",!
+3 SET FHINDX=0
FOR FHI=0:0
SET FHI=$ORDER(^DGPM("APTT1",DFN,FHI))
if FHI'>0
QUIT
Begin DoDot:1
+4 SET FHINDX=FHINDX+1
+5 SET FHLST(FHINDX)=FHI
SET Y=FHI
DO DD^%DT
WRITE !,FHINDX,?5,Y
+6 QUIT
End DoDot:1
+7 DO SELADM
IF '$GET(FHADM)
DO EX
QUIT
+8 DO DEV
DO EX
QUIT
+9 ;
EN ;
+1 SET FHZ115="P"_DFN
DO CHECK^FHOMDPA
IF FHDFN=""
QUIT
+2 SET PG=0
SET EX=""
DO NOW^%DTC
SET Y=X
DO DD^%DT
SET FHNDT=Y
DO HDR
+3 SET FLG=0
IF '$ORDER(^FHPT(FHDFN,"A",FHADM,"MO",0))
Begin DoDot:1
+4 WRITE "NO MONITORS FOR THIS PATIENT"
SET FLG=1
QUIT
End DoDot:1
+5 if FLG
QUIT
+6 SET J=0
FOR
SET J=$ORDER(^FHPT(FHDFN,"A",FHADM,"MO",J))
if 'J!(EX=U)
QUIT
Begin DoDot:1
+7 IF $Y>(IOSL-4)
DO PG
IF EX=U
QUIT
+8 WRITE !!?3,$PIECE(^FHPT(FHDFN,"A",FHADM,"MO",J,0),U,1)
+9 WRITE !?6,"Entered: "
SET Y=$PIECE(^(0),U,2)
XECUTE ^DD("DD")
WRITE Y
KILL Y
+10 SET Y=$PIECE(^FHPT(FHDFN,"A",FHADM,"MO",J,0),U,5)
if 'Y
QUIT
+11 WRITE ?40,"Cleared: "
XECUTE ^DD("DD")
WRITE Y
QUIT
End DoDot:1
+12 IF IOST?1"C".E
IF EX'=U
WRITE !
KILL DIR
SET DIR(0)="E"
DO ^DIR
EX KILL %DT,X,Y,FHI,FHINDX,FHLST,FHADM,FHNDT,FHDFN,DFN,SSN,FLG,J
+1 QUIT
DEV ;device and queue info
+1 WRITE !
KILL %ZIS,IOP
SET %ZIS="Q"
DO ^%ZIS
if POP
QUIT
+2 IF '$DATA(IO("Q"))
USE IO
DO EN
DO ^%ZISC
QUIT
+3 SET ZTRTN="EN^FHMNINQ"
+4 SET ZTSAVE("FHI")=""
SET ZTSAVE("FHINDX")=""
SET ZTSAVE("FHNDT")=""
+5 SET ZTSAVE("FHLST")=""
SET ZTSAVE("FHADM")=""
+6 SET ZTSAVE("DFN")=""
SET ZTSAVE("FHDFN")=""
+7 SET ZTDESC="Dietetics Monitor Inquiry"
DO ^%ZTLOAD
+8 DO ^%ZISC
KILL %ZIS,IOP
+9 QUIT
SELADM ;
+1 KILL DIR
WRITE !
SET DIR(0)="N"
+2 SET DIR("A")="Select Admission Date for this Patient"
+3 DO ^DIR
+4 if $DATA(DIRUT)
QUIT
+5 IF Y<1!(Y>FHINDX)
WRITE !!,"Response must be no less than 1 and no greater than ",FHINDX,"."
DO SELADM
QUIT
+6 SET FHI=FHLST(Y)
SET FHADM=$ORDER(^DGPM("APTT1",DFN,FHI,0))
+7 QUIT
PG ;
+1 IF IOST?1"C".E
WRITE !
KILL DIR
SET DIR(0)="E"
DO ^DIR
IF 'Y
SET EX=U
QUIT
+2 DO HDR
QUIT
HDR ;
+1 if $Y
WRITE @IOF
WRITE !,FHNDT,?60,"Page: "
SET PG=PG+1
WRITE PG,!!
+2 WRITE $EXTRACT($PIECE(^DPT(DFN,0),U,1),1,28)
SET SSN=$PIECE(^(0),U,9)
+3 WRITE ?30,$EXTRACT(SSN,1,3)_"-"_$EXTRACT(SSN,4,5)_"-"_$EXTRACT(SSN,6,9)
+4 WRITE ?44,"Admission Date: "
SET Y=FHI
XECUTE ^DD("DD")
WRITE Y
+5 WRITE !
FOR Z=1:1:79
WRITE "="
