- FHNO8 ; HISC/REL - History of Supp. Fdgs. ;5/17/93 14:24
- ;;5.5;DIETETICS;**5**;Jan 28, 2005;Build 53
- ;patch #5 - add outpatient SFs,
- ;
- SF K FHDFN,X,WARD,SDT,EDT,STDT,ENDT
- S ADM="",FHALL=1 D ^FHOMDPA
- G:'FHDFN KIL
- I $O(^FHPT(FHDFN,"A",0))<1 W !!,"NO ADMISSIONS ON FILE!" G OSF
- S DIC="^FHPT(FHDFN,""A"",",DIC(0)="Q",DA=FHDFN,X="??" D ^DIC
- S WARD="" I $G(DFN)'="" S WARD=$G(^DPT(DFN,.1))
- K ADM
- SF0 W !!,"Select ADMISSION or RETURN for OUTPATIENT ",$S(WARD'="":" (or C for CURRENT)",1:""),": " R X:DTIME G:X["^" KIL D:X="c" TR^FH
- I (X="")&'($D(^FHPT(FHDFN,"OP"))) W !!,"NO OUTPATIENT DATA ON FILE!" G SF
- I (X="")&($D(^FHPT(FHDFN,"OP"))) G OSF
- I WARD'="",X="C" S ADM=$G(^DPT("CN",WARD,DFN)) G CAD:ADM
- S DIC="^FHPT(FHDFN,""A"",",DIC(0)="EQM" D ^DIC G:Y<1 SF0 S ADM=+Y
- CAD I $G(ADM),$G(^FHPT(FHDFN,"A",ADM,0)) G IN
- ;
- SF1 I '($D(^FHPT(FHDFN,"OP"))) W !!,"NO OUTPATIENT DATA ON FILE!" G SF
- W !!,"Enter the Start Date and End Date for outpatient data.",!
- D STDATE^FHOMUTL S SDT=STDT I STDT="" Q
- S X="T+30" D ^%DT S ENDT=Y
- D DD^%DT S FHDTDF=Y K DIR
- S DIR("A")="Select End Date: ",DIR("B")=FHDTDF,DIR(0)="DAO^"_STDT
- D ^DIR
- Q:$D(DIRUT) S ENDT=Y S Y=ENDT D DD^%DT W " ",Y
- D ADM
- Q
- OSF ;process outpatient SFs.
- ;
- S FHSFLG=0
- S FHSOOP=$O(^FHPT(FHDFN,"OP","B",DT-30))
- I '$D(^FHPT(FHDFN,"OP"))!'$G(FHSOOP) G FHNO8
- ;W !!,"Outpatient Recurring Meals... "
- D ASK0
- G:'$G(ADM) SF
- S (N1,LST)=0
- I $G(ADM) F K=0:0 S K=$O(^FHPT(FHDFN,"OP",ADM,"SF",K)) Q:K<1 S X=^(K,0),LST=K D LIS
- I $G(ADM),'N1 W !!,"No Supplemental Feedings for this outpatient date!",! K DIR S DIR(0)="E",DIR("A")="Enter RETURN to Continue or '^' to Exit" D ^DIR Q:'Y G OSF
- I $G(ADM),$G(N1) G OSF0
- G OSF
- OSF0 R !!,"Detailed Display of which Order #? ",X:DTIME G:'$T!("^"[X) FHNO8 I X'?1N.N!(X<1)!(X>LST) W *7," Enter # of Order to List" G OSF0
- S NO=+X,Y=$G(^FHPT(FHDFN,"OP",ADM,"SF",NO,0)) D:Y'="" L1^FHNO7
- G SF
- Q
- ASK0 ;ask for Recurring Meal entry.
- K ADM
- W @IOF,!,"Outpatient Recurring Meals... "
- S FHQ=0,FHSDT=DT-60
- F FHI=FHSDT-1:0 S FHI=$O(^FHPT("RM",FHI)) Q:FHI'>0!FHQ F FHJ=0:0 S FHJ=$O(^FHPT("RM",FHI,FHDFN,FHJ)) Q:FHJ'>0!FHQ I ($P($G(^FHPT(FHDFN,"OP",FHJ,0)),U,15)'="C") D
- .S FHDA15=$G(^FHPT(FHDFN,"OP",FHJ,0))
- .S FHMEAL=$P(FHDA15,U,4),FHLOC=$P(FHDA15,U,3),FHLOCN=$P($G(^FH(119.6,FHLOC,0)),U,1),FHMEAL=$S(FHMEAL="B":"Break",FHMEAL="N":"Noon",1:"Even"),FH11=FHMEAL_" "_FHLOCN
- .S Y=$P(FHDA15,U,1) X ^DD("DD") S DTP=Y
- .S (FHCOFLG,FHDATL,FHSF)=0
- .I $Y>(IOSL-5) K DIR S DIR(0)="E",DIR("A")="Enter RETURN to Continue or '^' to Quit Listing" D ^DIR W:Y @IOF I 'Y S FHQ=1 Q
- .W !,DTP,?12,FH11
- .S FHDATL=$L(DTP)+13+$L(FH11)
- .S:$D(^FHPT(FHDFN,"OP",FHJ,"SF",0)) FHSF=$P(^FHPT(FHDFN,"OP",FHJ,"SF",0),U,3)
- .Q:'$G(FHSF)
- .S FHDA15SF=$G(^FHPT(FHDFN,"OP",FHJ,"SF",FHSF,0))
- .Q:$P(FHDA15SF,U,32)
- .S FHDASFNM=$P($G(^FH(118.1,$P(FHDA15SF,U,4),0)),U,1)
- .W ?40," (",FHDASFNM,")"
- W !
- K DIC S DIC(0)="AEQM"
- S DIC("W")="S FHMEAL=$P(^(0),U,4),FHLOC=$P(^(0),U,3),FHLOCN=$P($G(^FH(119.6,FHLOC,0)),U,1),FHMEAL=$S(FHMEAL=""B"":""Break"",FHMEAL=""N"":""Noon"",1:""Even""),FH11=FHMEAL_"" ""_FHLOCN D EN^DDIOL(FH11,"""",""?3"")"
- S DIC("S")="I $P(^FHPT(FHDFN,""OP"",+Y,0),U,1)>(DT-60)"
- S DIC="^FHPT(FHDFN,""OP"","
- S DIC("?")="Select a Date, '^' to exit"
- S DIC("A")="Select the Outpatient Date :" D ^DIC K DIC Q:(Y'>0)!$D(DTOUT)
- S ADM=+Y
- S FHMEAL=$P($G(^FHPT(FHDFN,"OP",ADM,0)),U,4) ;outpatient standing orders.
- Q
- ;
- S ALL=1 D ^FHDPA G:'DFN KIL G:'FHDFN KIL
- I $O(^FHPT(FHDFN,"A",0))<1 W !!,"NO ADMISSIONS ON FILE!" G FHNO8
- S DIC="^FHPT(FHDFN,""A"",",DIC(0)="Q",DA=FHDFN,X="??" D ^DIC
- A0 W !!,"Select ADMISSION",$S($D(^DPT(DFN,.1)):" (or C for CURRENT)",1:""),": " R X:DTIME G:'$T!("^"[X) KIL D:X="c" TR^FH
- ;
- IN ;D ADM G SF0:ADM'>0
- ;
- P0 S (N1,LST)=0 F K=0:0 S K=$O(^FHPT(FHDFN,"A",ADM,"SF",K)) Q:K<1 S X=^(K,0),LST=K D LIS
- I 'N1 W !!,"No Supplemental Feedings for this Admission!" G FHNO8
- P1 R !!,"Detailed Display of which Order #? ",X:DTIME G:'$T!("^"[X) FHNO8 I X'?1N.N!(X<1)!(X>LST) W *7," Enter # of Order to List" G P1
- S NO=+X,Y=$G(^FHPT(FHDFN,"A",ADM,"SF",NO,0)) D L1^FHNO7
- G SF
- ADM ;S WARD=$G(^DPT(DFN,.1))
- ;I WARD="" W *7,!!,"NOT CURRENTLY AN INPATIENT!",! S ADM="" Q
- ;S ADM=$G(^DPT("CN",WARD,DFN)) Q
- ;
- LIS I 'N1 W !!,"Ord Date/Time Ordered Supplemental Feeding Menu Date/Time Cancelled",!
- S N1=N1+1,D1=$P(X,"^",2),NM=$P(X,"^",4),D2=$P(X,"^",32)
- S DTP=D1 D DTP^FH W !,$J(K,3)," ",DTP
- S X=$P($G(^FH(118.1,+NM,0)),"^",1) W:X'="" ?24,X
- I D2 S DTP=D2 D DTP^FH W ?54,DTP
- Q
- KIL G KILL^XUSCLEAN
- FHNO8 ; HISC/REL - History of Supp. Fdgs. ;5/17/93 14:24
- +1 ;;5.5;DIETETICS;**5**;Jan 28, 2005;Build 53
- +2 ;patch #5 - add outpatient SFs,
- +3 ;
- SF KILL FHDFN,X,WARD,SDT,EDT,STDT,ENDT
- +1 SET ADM=""
- SET FHALL=1
- DO ^FHOMDPA
- +2 IF 'FHDFN
- GOTO KIL
- +3 IF $ORDER(^FHPT(FHDFN,"A",0))<1
- WRITE !!,"NO ADMISSIONS ON FILE!"
- GOTO OSF
- +4 SET DIC="^FHPT(FHDFN,""A"","
- SET DIC(0)="Q"
- SET DA=FHDFN
- SET X="??"
- DO ^DIC
- +5 SET WARD=""
- IF $GET(DFN)'=""
- SET WARD=$GET(^DPT(DFN,.1))
- +6 KILL ADM
- SF0 WRITE !!,"Select ADMISSION or RETURN for OUTPATIENT ",$SELECT(WARD'="":" (or C for CURRENT)",1:""),": "
- READ X:DTIME
- IF X["^"
- GOTO KIL
- IF X="c"
- DO TR^FH
- +1 IF (X="")&'($DATA(^FHPT(FHDFN,"OP")))
- WRITE !!,"NO OUTPATIENT DATA ON FILE!"
- GOTO SF
- +2 IF (X="")&($DATA(^FHPT(FHDFN,"OP")))
- GOTO OSF
- +3 IF WARD'=""
- IF X="C"
- SET ADM=$GET(^DPT("CN",WARD,DFN))
- IF ADM
- GOTO CAD
- +4 SET DIC="^FHPT(FHDFN,""A"","
- SET DIC(0)="EQM"
- DO ^DIC
- IF Y<1
- GOTO SF0
- SET ADM=+Y
- CAD IF $GET(ADM)
- IF $GET(^FHPT(FHDFN,"A",ADM,0))
- GOTO IN
- +1 ;
- SF1 IF '($DATA(^FHPT(FHDFN,"OP")))
- WRITE !!,"NO OUTPATIENT DATA ON FILE!"
- GOTO SF
- +1 WRITE !!,"Enter the Start Date and End Date for outpatient data.",!
- +2 DO STDATE^FHOMUTL
- SET SDT=STDT
- IF STDT=""
- QUIT
- +3 SET X="T+30"
- DO ^%DT
- SET ENDT=Y
- +4 DO DD^%DT
- SET FHDTDF=Y
- KILL DIR
- +5 SET DIR("A")="Select End Date: "
- SET DIR("B")=FHDTDF
- SET DIR(0)="DAO^"_STDT
- +6 DO ^DIR
- +7 IF $DATA(DIRUT)
- QUIT
- SET ENDT=Y
- SET Y=ENDT
- DO DD^%DT
- WRITE " ",Y
- +8 DO ADM
- +9 QUIT
- OSF ;process outpatient SFs.
- +1 ;
- +2 SET FHSFLG=0
- +3 SET FHSOOP=$ORDER(^FHPT(FHDFN,"OP","B",DT-30))
- +4 IF '$DATA(^FHPT(FHDFN,"OP"))!'$GET(FHSOOP)
- GOTO FHNO8
- +5 ;W !!,"Outpatient Recurring Meals... "
- +6 DO ASK0
- +7 IF '$GET(ADM)
- GOTO SF
- +8 SET (N1,LST)=0
- +9 IF $GET(ADM)
- FOR K=0:0
- SET K=$ORDER(^FHPT(FHDFN,"OP",ADM,"SF",K))
- IF K<1
- QUIT
- SET X=^(K,0)
- SET LST=K
- DO LIS
- +10 IF $GET(ADM)
- IF 'N1
- WRITE !!,"No Supplemental Feedings for this outpatient date!",!
- KILL DIR
- SET DIR(0)="E"
- SET DIR("A")="Enter RETURN to Continue or '^' to Exit"
- DO ^DIR
- IF 'Y
- QUIT
- GOTO OSF
- +11 IF $GET(ADM)
- IF $GET(N1)
- GOTO OSF0
- +12 GOTO OSF
- OSF0 READ !!,"Detailed Display of which Order #? ",X:DTIME
- IF '$TEST!("^"[X)
- GOTO FHNO8
- IF X'?1N.N!(X<1)!(X>LST)
- WRITE *7," Enter # of Order to List"
- GOTO OSF0
- +1 SET NO=+X
- SET Y=$GET(^FHPT(FHDFN,"OP",ADM,"SF",NO,0))
- IF Y'=""
- DO L1^FHNO7
- +2 GOTO SF
- +3 QUIT
- ASK0 ;ask for Recurring Meal entry.
- +1 KILL ADM
- +2 WRITE @IOF,!,"Outpatient Recurring Meals... "
- +3 SET FHQ=0
- SET FHSDT=DT-60
- +4 FOR FHI=FHSDT-1:0
- SET FHI=$ORDER(^FHPT("RM",FHI))
- IF FHI'>0!FHQ
- QUIT
- FOR FHJ=0:0
- SET FHJ=$ORDER(^FHPT("RM",FHI,FHDFN,FHJ))
- IF FHJ'>0!FHQ
- QUIT
- IF ($PIECE($GET(^FHPT(FHDFN,"OP",FHJ,0)),U,15)'="C")
- Begin DoDot:1
- +5 SET FHDA15=$GET(^FHPT(FHDFN,"OP",FHJ,0))
- +6 SET FHMEAL=$PIECE(FHDA15,U,4)
- SET FHLOC=$PIECE(FHDA15,U,3)
- SET FHLOCN=$PIECE($GET(^FH(119.6,FHLOC,0)),U,1)
- SET FHMEAL=$SELECT(FHMEAL="B":"Break",FHMEAL="N":"Noon",1:"Even")
- SET FH11=FHMEAL_" "_FHLOCN
- +7 SET Y=$PIECE(FHDA15,U,1)
- XECUTE ^DD("DD")
- SET DTP=Y
- +8 SET (FHCOFLG,FHDATL,FHSF)=0
- +9 IF $Y>(IOSL-5)
- KILL DIR
- SET DIR(0)="E"
- SET DIR("A")="Enter RETURN to Continue or '^' to Quit Listing"
- DO ^DIR
- IF Y
- WRITE @IOF
- IF 'Y
- SET FHQ=1
- QUIT
- +10 WRITE !,DTP,?12,FH11
- +11 SET FHDATL=$LENGTH(DTP)+13+$LENGTH(FH11)
- +12 IF $DATA(^FHPT(FHDFN,"OP",FHJ,"SF",0))
- SET FHSF=$PIECE(^FHPT(FHDFN,"OP",FHJ,"SF",0),U,3)
- +13 IF '$GET(FHSF)
- QUIT
- +14 SET FHDA15SF=$GET(^FHPT(FHDFN,"OP",FHJ,"SF",FHSF,0))
- +15 IF $PIECE(FHDA15SF,U,32)
- QUIT
- +16 SET FHDASFNM=$PIECE($GET(^FH(118.1,$PIECE(FHDA15SF,U,4),0)),U,1)
- +17 WRITE ?40," (",FHDASFNM,")"
- End DoDot:1
- +18 WRITE !
- +19 KILL DIC
- SET DIC(0)="AEQM"
- +20 SET DIC("W")="S FHMEAL=$P(^(0),U,4),FHLOC=$P(^(0),U,3),FHLOCN=$P($G(^FH(119.6,FHLOC,0)),U,1),FHMEAL=$S(FHMEAL=""B"":""Break"",FHMEAL=""N"":""Noon"",1:""Even""),FH11=FHMEAL_"" ""_FHLOCN D EN^DDIOL(FH11,"""",""?3"")"
- +21 SET DIC("S")="I $P(^FHPT(FHDFN,""OP"",+Y,0),U,1)>(DT-60)"
- +22 SET DIC="^FHPT(FHDFN,""OP"","
- +23 SET DIC("?")="Select a Date, '^' to exit"
- +24 SET DIC("A")="Select the Outpatient Date :"
- DO ^DIC
- KILL DIC
- IF (Y'>0)!$DATA(DTOUT)
- QUIT
- +25 SET ADM=+Y
- +26 ;outpatient standing orders.
- SET FHMEAL=$PIECE($GET(^FHPT(FHDFN,"OP",ADM,0)),U,4)
- +27 QUIT
- +28 ;
- +29 SET ALL=1
- DO ^FHDPA
- IF 'DFN
- GOTO KIL
- IF 'FHDFN
- GOTO KIL
- +30 IF $ORDER(^FHPT(FHDFN,"A",0))<1
- WRITE !!,"NO ADMISSIONS ON FILE!"
- GOTO FHNO8
- +31 SET DIC="^FHPT(FHDFN,""A"","
- SET DIC(0)="Q"
- SET DA=FHDFN
- SET X="??"
- DO ^DIC
- A0 WRITE !!,"Select ADMISSION",$SELECT($DATA(^DPT(DFN,.1)):" (or C for CURRENT)",1:""),": "
- READ X:DTIME
- IF '$TEST!("^"[X)
- GOTO KIL
- IF X="c"
- DO TR^FH
- +1 ;
- IN ;D ADM G SF0:ADM'>0
- +1 ;
- P0 SET (N1,LST)=0
- FOR K=0:0
- SET K=$ORDER(^FHPT(FHDFN,"A",ADM,"SF",K))
- IF K<1
- QUIT
- SET X=^(K,0)
- SET LST=K
- DO LIS
- +1 IF 'N1
- WRITE !!,"No Supplemental Feedings for this Admission!"
- GOTO FHNO8
- P1 READ !!,"Detailed Display of which Order #? ",X:DTIME
- IF '$TEST!("^"[X)
- GOTO FHNO8
- IF X'?1N.N!(X<1)!(X>LST)
- WRITE *7," Enter # of Order to List"
- GOTO P1
- +1 SET NO=+X
- SET Y=$GET(^FHPT(FHDFN,"A",ADM,"SF",NO,0))
- DO L1^FHNO7
- +2 GOTO SF
- ADM ;S WARD=$G(^DPT(DFN,.1))
- +1 ;I WARD="" W *7,!!,"NOT CURRENTLY AN INPATIENT!",! S ADM="" Q
- +2 ;S ADM=$G(^DPT("CN",WARD,DFN)) Q
- +3 ;
- LIS IF 'N1
- WRITE !!,"Ord Date/Time Ordered Supplemental Feeding Menu Date/Time Cancelled",!
- +1 SET N1=N1+1
- SET D1=$PIECE(X,"^",2)
- SET NM=$PIECE(X,"^",4)
- SET D2=$PIECE(X,"^",32)
- +2 SET DTP=D1
- DO DTP^FH
- WRITE !,$JUSTIFY(K,3)," ",DTP
- +3 SET X=$PIECE($GET(^FH(118.1,+NM,0)),"^",1)
- IF X'=""
- WRITE ?24,X
- +4 IF D2
- SET DTP=D2
- DO DTP^FH
- WRITE ?54,DTP
- +5 QUIT
- KIL GOTO KILL^XUSCLEAN
