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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFHOMGC1 2933 printed Nov 22, 2024@17:02:56 Page 2
FHOMGC1 ;Hines OIFO/RTK GUEST MEALS CANCEL MEAL ;11/21/05 12:55
+1 ;;5.5;DIETETICS;**5**;Jan 28, 2005;Build 53
+2 ;
+3 SET X1=DT
SET X2=-1
DO C^%DTC
SET STDT=X_.99
SET ENDT=9999999
+4 DO LIST
IF NUM=0
QUIT
+5 WRITE !
KILL DIR
SET DIR("A")="Cancel Which Meal(s)?"
SET DIR(0)="LO^1:"_NUM
DO ^DIR
+6 if $DATA(DIRUT)
QUIT
SET FHCLST=Y
+7 WRITE !
KILL DIR
SET DIR("A")="Are you sure? "
SET DIR(0)="YA"
SET DIR("B")="Y"
DO ^DIR
+8 if $DATA(DIRUT)
QUIT
IF Y=0
DO END
QUIT
+9 FOR A=1:1:NUM
SET FHC=$PIECE(FHCLST,",",A)
if FHC=""
QUIT
SET FHCDT=FHLIST(FHC)
DO CAN
+10 WRITE " ... done"
QUIT
+11 KILL DIR,STDT,ENDT
QUIT
CAN ;
+1 SET FHSTAT="C"
+2 SET DA=$PIECE(FHCDT,U,2)
SET FHDA=DA
SET DA(1)=$PIECE(FHCDT,U,1)
SET FHDFN=DA(1)
+3 IF '$DATA(^FHPT(DA(1),"GM",DA,0))
QUIT
+4 SET DIE="^FHPT("_DA(1)_",""GM"","
+5 SET DR="8////^S X=FHSTAT;9////^S X=DUZ"
DO ^DIE
+6 SET FHZN=$GET(^FHPT(FHDFN,"GM",FHDA,0))
+7 SET FHACT="C"
SET FHOPTY="G"
SET FHOPDT=FHDA
DO SETGM^FHOMRO2
+8 QUIT
END ;
+1 KILL FHSTAT
QUIT
+2 ;
LIST ; Display for cancel screen - First build data in ^TMP global
+1 KILL ^TMP($JOB)
SET NUM=0
SET EX=""
+2 FOR FHGMDT=STDT:0
SET FHGMDT=$ORDER(^FHPT("GM",FHGMDT))
if FHGMDT'>0!(FHGMDT>ENDT)
QUIT
Begin DoDot:1
+3 FOR FHDFN=0:0
SET FHDFN=$ORDER(^FHPT("GM",FHGMDT,FHDFN))
if FHDFN'>0
QUIT
Begin DoDot:2
+4 SET FHZN=$GET(^FHPT(FHDFN,"GM",FHGMDT,0))
SET FHST=$PIECE(FHZN,U,9)
IF FHST="C"
QUIT
+5 DO PATNAME^FHOMUTL
IF FHDFN=""
QUIT
+6 SET FHLOC=$PIECE(FHZN,U,5)
if FHLOC=""
QUIT
+7 SET FHPRORD=$PIECE($GET(^FH(119.6,FHLOC,0)),U,4)
IF FHPRORD=""
SET FHPRORD=99
+8 SET FHPRORD=$SELECT(FHPRORD<1:99,FHPRORD<10:"0"_FHPRORD,1:FHPRORD)
+9 SET FHLOCNM=$PIECE($GET(^FH(119.6,FHLOC,0)),U,1)
+10 SET ^TMP($JOB,FHPRORD_"~"_FHLOCNM,FHGMDT,FHPTNM_"~"_FHDFN)=FHZN
+11 QUIT
End DoDot:2
+12 QUIT
End DoDot:1
+13 IF '$DATA(^TMP($JOB))
WRITE !!,"THERE ARE CURRENTLY NO GUEST MEALS TO CANCEL"
QUIT
+14 DO HDR
+15 SET FHLSRT=""
FOR
SET FHLSRT=$ORDER(^TMP($JOB,FHLSRT))
if FHLSRT=""!(EX=U)
QUIT
Begin DoDot:1
+16 FOR FHGMDT=STDT:0
SET FHGMDT=$ORDER(^TMP($JOB,FHLSRT,FHGMDT))
if FHGMDT'>0!(FHGMDT>ENDT)!(EX=U)
QUIT
Begin DoDot:2
+17 SET FHPTN=""
FOR
SET FHPTN=$ORDER(^TMP($JOB,FHLSRT,FHGMDT,FHPTN))
if FHPTN=""!(EX=U)
QUIT
Begin DoDot:3
+18 SET FHNODE=$GET(^TMP($JOB,FHLSRT,FHGMDT,FHPTN))
+19 SET NUM=NUM+1
SET PAD=$SELECT($LENGTH(NUM)=1:" ",1:"")
WRITE !,PAD,NUM
+20 SET FHDFN=$PIECE(FHPTN,"~",2)
DO PATNAME^FHOMUTL
WRITE ?4,$EXTRACT(FHPTNM,1,20)
+21 SET FHCL=$PIECE(FHNODE,U,2)
SET FHML=$PIECE(FHNODE,U,3)
SET FHCH=$PIECE(FHNODE,U,4)
+22 SET FHLPT=$PIECE(FHNODE,U,5)
IF FHLPT=""
QUIT
+23 SET FHRMBD=$PIECE(FHNODE,U,11)
SET FHRMBNM=""
+24 IF FHRMBD'=""
SET FHRMBNM="/"_$EXTRACT($PIECE($GET(^DG(405.4,FHRMBD,0)),U,1),1,11)
+25 IF FHRMBNM=""
SET FHLOC=$EXTRACT($PIECE($GET(^FH(119.6,FHLPT,0)),U,1),1,24)
+26 IF FHRMBNM'=""
SET FHLOC=$EXTRACT($PIECE($GET(^FH(119.6,FHLPT,0)),U,1),1,12)
+27 SET FHCL=$SELECT(FHCL="E":"EMP",FHCL="G":"GRAT",FHCL="O":"OOD",FHCL="P":"PAID",1:"VOL")
+28 SET FHD=$$FMTE^XLFDT(FHGMDT,"P")
WRITE ?25,$EXTRACT(FHD,1,12)
+29 WRITE ?38,FHLOC,FHRMBNM,?64,FHML,?68,FHCL,?74,FHCH
+30 SET FHLIST(NUM)=FHDFN_"^"_FHGMDT
+31 IF $Y>(IOSL-4)
DO PG
IF EX=U
QUIT
End DoDot:3
+32 QUIT
End DoDot:2
+33 QUIT
End DoDot:1
+34 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
+2 WRITE !?5,"G U E S T M E A L L I S T"
+3 WRITE !!," # ",?4,"Name",?25,"Date",?38,"Location",?63,"Meal"
+4 WRITE ?68,"Class",?74,"Charge"
+5 WRITE !,"===",?4,"====================",?25,"============"
+6 WRITE ?38,"========================",?63,"====",?68,"=====",?74,"======"
+7 QUIT
