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

FHOMGC1 ;Hines OIFO/RTK GUEST MEALS CANCEL MEAL  ;11/21/05  12:55
 ;;5.5;DIETETICS;**5**;Jan 28, 2005;Build 53
 ;
 S X1=DT,X2=-1 D C^%DTC S STDT=X_.99,ENDT=9999999
 D LIST I NUM=0 Q
 W ! K DIR S DIR("A")="Cancel Which Meal(s)?",DIR(0)="LO^1:"_NUM D ^DIR
 Q:$D(DIRUT)  S FHCLST=Y
 W ! K DIR S DIR("A")="Are you sure? ",DIR(0)="YA",DIR("B")="Y" D ^DIR
 Q:$D(DIRUT)  I Y=0 D END Q
 F A=1:1:NUM S FHC=$P(FHCLST,",",A) Q:FHC=""  S FHCDT=FHLIST(FHC) D CAN
 W "  ... done" Q
 K DIR,STDT,ENDT Q
CAN ;
 S FHSTAT="C"
 S DA=$P(FHCDT,U,2),FHDA=DA,DA(1)=$P(FHCDT,U,1),FHDFN=DA(1)
 I '$D(^FHPT(DA(1),"GM",DA,0)) Q
 S DIE="^FHPT("_DA(1)_",""GM"","
 S DR="8////^S X=FHSTAT;9////^S X=DUZ" D ^DIE
 S FHZN=$G(^FHPT(FHDFN,"GM",FHDA,0))
 S FHACT="C",FHOPTY="G",FHOPDT=FHDA D SETGM^FHOMRO2
 Q
END ;
 K FHSTAT Q
 ;
LIST ; Display for cancel screen - First build data in ^TMP global
 K ^TMP($J) S NUM=0,EX=""
 F FHGMDT=STDT:0 S FHGMDT=$O(^FHPT("GM",FHGMDT)) Q:FHGMDT'>0!(FHGMDT>ENDT)  D
 .F FHDFN=0:0 S FHDFN=$O(^FHPT("GM",FHGMDT,FHDFN)) Q:FHDFN'>0  D
 ..S FHZN=$G(^FHPT(FHDFN,"GM",FHGMDT,0)),FHST=$P(FHZN,U,9) I FHST="C" Q
 ..D PATNAME^FHOMUTL I FHDFN="" Q
 ..S FHLOC=$P(FHZN,U,5) Q:FHLOC=""
 ..S FHPRORD=$P($G(^FH(119.6,FHLOC,0)),U,4) I FHPRORD="" S FHPRORD=99
 ..S FHPRORD=$S(FHPRORD<1:99,FHPRORD<10:"0"_FHPRORD,1:FHPRORD)
 ..S FHLOCNM=$P($G(^FH(119.6,FHLOC,0)),U,1)
 ..S ^TMP($J,FHPRORD_"~"_FHLOCNM,FHGMDT,FHPTNM_"~"_FHDFN)=FHZN
 ..Q
 .Q
 I '$D(^TMP($J)) W !!,"THERE ARE CURRENTLY NO GUEST MEALS TO CANCEL" Q
 D HDR
 S FHLSRT="" F  S FHLSRT=$O(^TMP($J,FHLSRT)) Q:FHLSRT=""!(EX=U)  D
 .F FHGMDT=STDT:0 S FHGMDT=$O(^TMP($J,FHLSRT,FHGMDT)) Q:FHGMDT'>0!(FHGMDT>ENDT)!(EX=U)  D
 ..S FHPTN="" F  S FHPTN=$O(^TMP($J,FHLSRT,FHGMDT,FHPTN)) Q:FHPTN=""!(EX=U)  D
 ...S FHNODE=$G(^TMP($J,FHLSRT,FHGMDT,FHPTN))
 ...S NUM=NUM+1,PAD=$S($L(NUM)=1:" ",1:"") W !,PAD,NUM
 ...S FHDFN=$P(FHPTN,"~",2) D PATNAME^FHOMUTL W ?4,$E(FHPTNM,1,20)
 ...S FHCL=$P(FHNODE,U,2),FHML=$P(FHNODE,U,3),FHCH=$P(FHNODE,U,4)
 ...S FHLPT=$P(FHNODE,U,5) I FHLPT="" Q
 ...S FHRMBD=$P(FHNODE,U,11),FHRMBNM=""
 ...I FHRMBD'="" S FHRMBNM="/"_$E($P($G(^DG(405.4,FHRMBD,0)),U,1),1,11)
 ...I FHRMBNM="" S FHLOC=$E($P($G(^FH(119.6,FHLPT,0)),U,1),1,24)
 ...I FHRMBNM'="" S FHLOC=$E($P($G(^FH(119.6,FHLPT,0)),U,1),1,12)
 ...S FHCL=$S(FHCL="E":"EMP",FHCL="G":"GRAT",FHCL="O":"OOD",FHCL="P":"PAID",1:"VOL")
 ...S FHD=$$FMTE^XLFDT(FHGMDT,"P") W ?25,$E(FHD,1,12)
 ...W ?38,FHLOC,FHRMBNM,?64,FHML,?68,FHCL,?74,FHCH
 ...S FHLIST(NUM)=FHDFN_"^"_FHGMDT
 ...I $Y>(IOSL-4) D PG I EX=U Q
 ..Q
 .Q
 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 !?5,"G U E S T   M E A L   L I S T"
 W !!," # ",?4,"Name",?25,"Date",?38,"Location",?63,"Meal"
 W ?68,"Class",?74,"Charge"
 W !,"===",?4,"====================",?25,"============"
 W ?38,"========================",?63,"====",?68,"=====",?74,"======"
 Q