source: FOIAVistA/tag/r/DIETETICS-FH/FHMNINQ.m@ 628

Last change on this file since 628 was 628, checked in by George Lilly, 14 years ago

initial load of FOIAVistA 6/30/08 version

File size: 2.0 KB
Line 
1FHMNINQ ;Hines OIFO/JT,RTK - Dietetics Monitor Inquiry ;07/26/01 09:53
2 ;;5.5;DIETETICS;;Jan 28, 2005
3 ;
4DATE W ! K DIC S DIC="^DPT(",DIC(0)="AEQM" D ^DIC Q:Y<0 S DFN=+Y K DIC
5 I $O(^DGPM("APTT1",DFN,""))="" W !,"NO ADMISSIONS FOR THIS PATIENT!" H 2 Q
6 W !,"This patient has the following admissions:",!
7 S FHINDX=0 F FHI=0:0 S FHI=$O(^DGPM("APTT1",DFN,FHI)) Q:FHI'>0 D
8 .S FHINDX=FHINDX+1
9 .S FHLST(FHINDX)=FHI S Y=FHI D DD^%DT W !,FHINDX,?5,Y
10 .Q
11 D SELADM I '$G(FHADM) D EX Q
12 D DEV,EX Q
13 ;
14EN ;
15 S FHZ115="P"_DFN D CHECK^FHOMDPA I FHDFN="" Q
16 S PG=0,EX="" D NOW^%DTC S Y=X D DD^%DT S FHNDT=Y D HDR
17 S FLG=0 I '$O(^FHPT(FHDFN,"A",FHADM,"MO",0)) D
18 .W "NO MONITORS FOR THIS PATIENT" S FLG=1 Q
19 Q:FLG
20 S J=0 F S J=$O(^FHPT(FHDFN,"A",FHADM,"MO",J)) Q:'J!(EX=U) D
21 .I $Y>(IOSL-4) D PG I EX=U Q
22 .W !!?3,$P(^FHPT(FHDFN,"A",FHADM,"MO",J,0),U,1)
23 .W !?6,"Entered: " S Y=$P(^(0),U,2) X ^DD("DD") W Y K Y
24 .S Y=$P(^FHPT(FHDFN,"A",FHADM,"MO",J,0),U,5) Q:'Y
25 .W ?40,"Cleared: " X ^DD("DD") W Y Q
26 I IOST?1"C".E,EX'=U W ! K DIR S DIR(0)="E" D ^DIR
27EX K %DT,X,Y,FHI,FHINDX,FHLST,FHADM,FHNDT,FHDFN,DFN,SSN,FLG,J
28 Q
29DEV ;device and queue info
30 W ! K %ZIS,IOP S %ZIS="Q" D ^%ZIS Q:POP
31 I '$D(IO("Q")) U IO D EN,^%ZISC Q
32 S ZTRTN="EN^FHMNINQ"
33 S ZTSAVE("FHI")="",ZTSAVE("FHINDX")="",ZTSAVE("FHNDT")=""
34 S ZTSAVE("FHLST")="",ZTSAVE("FHADM")=""
35 S ZTSAVE("DFN")="",ZTSAVE("FHDFN")=""
36 S ZTDESC="Dietetics Monitor Inquiry" D ^%ZTLOAD
37 D ^%ZISC K %ZIS,IOP
38 Q
39SELADM ;
40 K DIR W ! S DIR(0)="N"
41 S DIR("A")="Select Admission Date for this Patient"
42 D ^DIR
43 Q:$D(DIRUT)
44 I Y<1!(Y>FHINDX) W !!,"Response must be no less than 1 and no greater than ",FHINDX,"." D SELADM Q
45 S FHI=FHLST(Y),FHADM=$O(^DGPM("APTT1",DFN,FHI,0))
46 Q
47PG ;
48 I IOST?1"C".E W ! K DIR S DIR(0)="E" D ^DIR I 'Y S EX=U Q
49 D HDR Q
50HDR ;
51 W:$Y @IOF W !,FHNDT,?60,"Page: " S PG=PG+1 W PG,!!
52 W $E($P(^DPT(DFN,0),U,1),1,28) S SSN=$P(^(0),U,9)
53 W ?30,$E(SSN,1,3)_"-"_$E(SSN,4,5)_"-"_$E(SSN,6,9)
54 W ?44,"Admission Date: " S Y=FHI X ^DD("DD") W Y
55 W ! F Z=1:1:79 W "="
Note: See TracBrowser for help on using the repository browser.