- 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 Feb 18, 2025@23:14:23 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 "="
