- 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 Mar 13, 2025@20:57:24 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
