source: WorldVistAEHR/trunk/r/DIETETICS-FH/FHOMGC1.m@ 1704

Last change on this file since 1704 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.8 KB
Line 
1FHOMGC1 ;Hines OIFO/RTK GUEST MEALS CANCEL MEAL ;11/21/05 12:55
2 ;;5.5;DIETETICS;**5**;Jan 28, 2005;Build 53
3 ;
4 S X1=DT,X2=-1 D C^%DTC S STDT=X_.99,ENDT=9999999
5 D LIST I NUM=0 Q
6 W ! K DIR S DIR("A")="Cancel Which Meal(s)?",DIR(0)="LO^1:"_NUM D ^DIR
7 Q:$D(DIRUT) S FHCLST=Y
8 W ! K DIR S DIR("A")="Are you sure? ",DIR(0)="YA",DIR("B")="Y" D ^DIR
9 Q:$D(DIRUT) I Y=0 D END Q
10 F A=1:1:NUM S FHC=$P(FHCLST,",",A) Q:FHC="" S FHCDT=FHLIST(FHC) D CAN
11 W " ... done" Q
12 K DIR,STDT,ENDT Q
13CAN ;
14 S FHSTAT="C"
15 S DA=$P(FHCDT,U,2),FHDA=DA,DA(1)=$P(FHCDT,U,1),FHDFN=DA(1)
16 I '$D(^FHPT(DA(1),"GM",DA,0)) Q
17 S DIE="^FHPT("_DA(1)_",""GM"","
18 S DR="8////^S X=FHSTAT;9////^S X=DUZ" D ^DIE
19 S FHZN=$G(^FHPT(FHDFN,"GM",FHDA,0))
20 S FHACT="C",FHOPTY="G",FHOPDT=FHDA D SETGM^FHOMRO2
21 Q
22END ;
23 K FHSTAT Q
24 ;
25LIST ; Display for cancel screen - First build data in ^TMP global
26 K ^TMP($J) S NUM=0,EX=""
27 F FHGMDT=STDT:0 S FHGMDT=$O(^FHPT("GM",FHGMDT)) Q:FHGMDT'>0!(FHGMDT>ENDT) D
28 .F FHDFN=0:0 S FHDFN=$O(^FHPT("GM",FHGMDT,FHDFN)) Q:FHDFN'>0 D
29 ..S FHZN=$G(^FHPT(FHDFN,"GM",FHGMDT,0)),FHST=$P(FHZN,U,9) I FHST="C" Q
30 ..D PATNAME^FHOMUTL I FHDFN="" Q
31 ..S FHLOC=$P(FHZN,U,5) Q:FHLOC=""
32 ..S FHPRORD=$P($G(^FH(119.6,FHLOC,0)),U,4) I FHPRORD="" S FHPRORD=99
33 ..S FHPRORD=$S(FHPRORD<1:99,FHPRORD<10:"0"_FHPRORD,1:FHPRORD)
34 ..S FHLOCNM=$P($G(^FH(119.6,FHLOC,0)),U,1)
35 ..S ^TMP($J,FHPRORD_"~"_FHLOCNM,FHGMDT,FHPTNM_"~"_FHDFN)=FHZN
36 ..Q
37 .Q
38 I '$D(^TMP($J)) W !!,"THERE ARE CURRENTLY NO GUEST MEALS TO CANCEL" Q
39 D HDR
40 S FHLSRT="" F S FHLSRT=$O(^TMP($J,FHLSRT)) Q:FHLSRT=""!(EX=U) D
41 .F FHGMDT=STDT:0 S FHGMDT=$O(^TMP($J,FHLSRT,FHGMDT)) Q:FHGMDT'>0!(FHGMDT>ENDT)!(EX=U) D
42 ..S FHPTN="" F S FHPTN=$O(^TMP($J,FHLSRT,FHGMDT,FHPTN)) Q:FHPTN=""!(EX=U) D
43 ...S FHNODE=$G(^TMP($J,FHLSRT,FHGMDT,FHPTN))
44 ...S NUM=NUM+1,PAD=$S($L(NUM)=1:" ",1:"") W !,PAD,NUM
45 ...S FHDFN=$P(FHPTN,"~",2) D PATNAME^FHOMUTL W ?4,$E(FHPTNM,1,20)
46 ...S FHCL=$P(FHNODE,U,2),FHML=$P(FHNODE,U,3),FHCH=$P(FHNODE,U,4)
47 ...S FHLPT=$P(FHNODE,U,5) I FHLPT="" Q
48 ...S FHRMBD=$P(FHNODE,U,11),FHRMBNM=""
49 ...I FHRMBD'="" S FHRMBNM="/"_$E($P($G(^DG(405.4,FHRMBD,0)),U,1),1,11)
50 ...I FHRMBNM="" S FHLOC=$E($P($G(^FH(119.6,FHLPT,0)),U,1),1,24)
51 ...I FHRMBNM'="" S FHLOC=$E($P($G(^FH(119.6,FHLPT,0)),U,1),1,12)
52 ...S FHCL=$S(FHCL="E":"EMP",FHCL="G":"GRAT",FHCL="O":"OOD",FHCL="P":"PAID",1:"VOL")
53 ...S FHD=$$FMTE^XLFDT(FHGMDT,"P") W ?25,$E(FHD,1,12)
54 ...W ?38,FHLOC,FHRMBNM,?64,FHML,?68,FHCL,?74,FHCH
55 ...S FHLIST(NUM)=FHDFN_"^"_FHGMDT
56 ...I $Y>(IOSL-4) D PG I EX=U Q
57 ..Q
58 .Q
59 Q
60PG ;
61 I IOST?1"C".E W ! K DIR S DIR(0)="E" D ^DIR I 'Y S EX=U Q
62 D HDR Q
63HDR ;
64 W:$Y @IOF
65 W !?5,"G U E S T M E A L L I S T"
66 W !!," # ",?4,"Name",?25,"Date",?38,"Location",?63,"Meal"
67 W ?68,"Class",?74,"Charge"
68 W !,"===",?4,"====================",?25,"============"
69 W ?38,"========================",?63,"====",?68,"=====",?74,"======"
70 Q
Note: See TracBrowser for help on using the repository browser.