- FHSP ; HISC/REL/NCA - Standing Orders ;2/13/95 14:30
- ;;5.5;DIETETICS;**5,8**;Jan 28, 2005;Build 28
- EN1 ; Enter/Edit Standing Orders
- K DIC W ! S (DIC,DIE)="^FH(118.3,",DIC(0)="AEQLM",DIC("DR")=".01",DLAYGO=118.3 W ! D ^DIC K DIC,DLAYGO G KIL:U[X!$D(DTOUT),EN1:Y<1
- S DA=+Y,DR=".01:99" S:$D(^XUSEC("FHMGR",DUZ)) DIDEL=118.3 D ^DIE K DA,DIE,DIDEL,DR G EN1
- EN2 ; List Standing Orders
- W ! S L=0,DIC="^FH(118.3,",FLDS=".01,99,1",BY="NAME"
- S FR="",TO="",DHD="STANDING ORDERS" D EN1^DIP
- K %ZIS S IOP="" D ^%ZIS G KIL
- SO ;OutPT SO
- S FHSOOP=$O(^FHPT(FHDFN,"OP","B",DT-1))
- I '$D(^FHPT(FHDFN,"OP"))!'$G(FHSOOP) W !!,"** NO OUTPATIENT DATA ON FILE! Please enter outpatient meals from Recurring Meals Menu [FHOMRMGR]." Q
- W @IOF,!,"Outpatient Recurring Meals... "
- A0 ;Rec Meal entry.
- K FHDM14,FHEDI,FHEDIF,FHIEN,FHMIEN,FHFLG,FHCK
- S FHQ=0
- S (FHTOTML("B"),FHTOTML("N"),FHTOTML("E"),FHTOTML("A"))=0
- F FHI=DT-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 FHDM14(FHI,$P(FHDA15,U,4))=FHI_U_FHJ
- .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)=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)
- .F FHSF=0:0 S FHSF=$O(^FHPT(FHDFN,"OP",FHJ,"SP",FHSF)) Q:FHSF'>0 D
- ..S FHDA15SF=$G(^FHPT(FHDFN,"OP",FHJ,"SP",FHSF,0))
- ..Q:$P(FHDA15SF,U,6)
- ..S FHDASFNM=$P($G(^FH(118.3,$P(FHDA15SF,U,2),0)),U,1),FHDASFQT=$P(FHDA15SF,U,8)
- ..I (FHDATL+$L(FHDASFNM)+3+$L(FHDASFQT))>79 W !,?19 S FHDATL=19
- ..I (FHDATL>19),(FHCOFLG=1) W ","
- ..S FHDATL=FHDATL+4+$L(FHDASFNM)+3+$L(FHDASFQT)
- ..W " ",FHDASFNM," = ",FHDASFQT
- ..S FHCOFLG=1
- F FHI=0:0 S FHI=$O(FHDM14(FHI)) Q:FHI'>0 D
- .F FHJ="B","N","E" Q:FHJ="" D
- ..I (FHJ="B")&$D(FHDM14(FHI,FHJ)) S FHTOTML("B")=FHTOTML("B")+1,FHIEN(FHJ)=FHDM14(FHI,FHJ)
- ..I (FHJ="N")&$D(FHDM14(FHI,FHJ)) S FHTOTML("N")=FHTOTML("N")+1,FHIEN(FHJ)=FHDM14(FHI,FHJ)
- ..I (FHJ="E")&$D(FHDM14(FHI,FHJ)) S FHTOTML("E")=FHTOTML("E")+1,FHIEN(FHJ)=FHDM14(FHI,FHJ)
- I '$D(FHDM14) W !!,"NO OUTPATIENT DATA ON FILE for today's date and the future!!",! Q
- ;
- R1 S (FHCNSOF,FH1,FHQ)=0,(FHDTML,FHX,FHALML)="" R !!,"Enter a Meal (B,N,E or ALL): ALL// ",FHDTML:DTIME
- Q:'$T!(FHDTML["^")
- S:FHDTML="" FHDTML="ALL"
- I FHDTML["?" S FHQ=1 G MS1
- S X=FHDTML D TR^FH S (FHX,FHDTML)=X
- I FHDTML="A" S FHQ=1 G MS1
- S FHALML=FHX
- I FHDTML="ALL" S FHDTML=$E(FHDTML,1),FHALML="BNE"
- I $L(FHDTML)=3 S:("BNE")'[$E(FHDTML,1) FHQ=1 S:("BNE")'[$E(FHDTML,2) FHQ=1 S:("BNE")'[$E(FHDTML,3) FHQ=1 S FHCK($E(FHDTML,1))="",FHCK($E(FHDTML,2))="",FHCK($E(FHDTML,3))=""
- I $L(FHDTML)=2 S:("BNE")'[$E(FHDTML,1) FHQ=1 S:("BNE")'[$E(FHDTML,2) FHQ=1 S FHCK($E(FHDTML,1))="",FHCK($E(FHDTML,2))=""
- I $L(FHDTML)=1 S:("ABNE")'[$E(FHDTML,1) FHQ=1 S FHCK(FHDTML)=""
- I FHDTML="A" S (FHCK("B"),FHCK("N"),FHCK("E"))=""
- S:$L(FHDTML)>3 FHQ=1
- G:FHQ MS1
- I $L(FHDTML)=3 S:'$G(FHTOTML($E(FHDTML,1))) FH1=1 S:'$G(FHTOTML($E(FHDTML,2))) FH1=1 S:'$G(FHTOTML($E(FHDTML,3))) FH1=1 I FH1 W !!,"There is no outpatient data for this Meal!!" G R1
- I $L(FHDTML)=2 S:'$G(FHTOTML($E(FHDTML,1))) FH1=1 S:'$G(FHTOTML($E(FHDTML,2))) FH1=1 I FH1 W !!,"There is no outpatient data for this Meal!!" G R1
- MS1 I FHQ W *7,!,"Select B for Breakfast, N for Noon, E for Evening or ALL for all meals",!,"Answer may be multiple meals, e.g., BN or NE" G R1
- S:$L(FHDTML)>1 FHDTML="A"
- S FHLIS=0
- I (FHDTML'="A"),(FHTOTML(FHDTML)'>0) W !!,"There is no outpatient data for this Meal!!" G R1
- I FHDTML'="A",(FHTOTML(FHDTML)=1) S FHEDI($P(FHIEN(FHDTML),U,2))="" G E0
- I FHDTML="A" G ALL
- I FHDTML'="A",(FHTOTML(FHDTML)>1) D CHK^FHSPED Q:'$G(FHFLG) ;quit dates are not entered for range.
- I $G(FHFLG) F FHI=FHDT1-1:0 S FHI=$O(FHDM14(FHI)) Q:(FHI'>0)!(FHI>FHDT2) S:$D(FHDM14(FHI,FHDTML)) FHEDI($P(FHDM14(FHI,FHDTML),U,2))=""
- G E0
- ALL S FHCT=0,(FHDT1,FHDT2,FHDTSV)=DT F FHI=DT-1:0 S FHI=$O(FHDM14(FHI)) S:'FHI FHDT2=FHDTSV Q:FHI'>0 S FHCT=FHCT+1,FHDTSV=FHI S:FHCT=1 FHDT1=FHI S FHJ="" F S FHJ=$O(FHDM14(FHI,FHJ)) Q:FHJ="" S FHEDI($P(FHDM14(FHI,FHJ),U,2))=""
- E0 S ADM=0
- E1 W ! S FHLOCN="",ADM=$O(FHEDI(ADM)) Q:'ADM S NO=1,MEAL=$P($G(^FHPT(FHDFN,"OP",ADM,0)),U,4),FHLOC=$P($G(^(0)),U,3)
- I FHX'="ALL",FHX'[MEAL G E1
- I $G(FHLOC) S FHLOCN=$P($G(^FH(119.6,FHLOC,0)),U,1)
- D LIS G:'LN N1
- K DIR W ! S DIR(0)="YA",DIR("A")="Edit a Standing Order? ",DIR("B")="YES" D ^DIR K DIR Q:$D(DIRUT)!$D(DIROUT) G N1:Y<1
- N0 R !!,"Edit which Order #? ",X:DTIME Q:'$T!("^"[X) I X'?1N.N!(X<1)!(X>LN) W *7," Enter # of Order to Edit" G N0
- S SP=$P(LS,",",+X),SP=$P($G(^FHPT(FHDFN,"OP",ADM,"SP",+SP,0)),"^",2) I $D(P(+X,SP)) S LN=+X G N1A
- W !!,"Standing Order ",$P($G(^FH(118.3,+SP,0)),"^",1)," added" S LN=LN+1,P(LN,SP)="" G N1A
- N1 K DIC W ! S DIC="^FH(118.3,",DIC("A")="Enter Standing Order: ",DIC(0)="AEQM"
- D ^DIC K DIC,DLAYGO Q:"^"[X!$D(DTOUT) G SO:Y<1 S SP=+Y
- W !!,"Standing Order ",$P($G(^FH(118.3,+SP,0)),"^",1)," added"
- S LN=LN+1,P(LN,SP)=""
- N1A W !,"Standing Order: ",$P($G(^FH(118.3,+SP,0)),"^",1)_" // " R X:DTIME G KIL:'$T
- I X="^" G E0
- I X="@" D SO3 W " .. Done" G E0
- I X'="" W *7,!,"Press Return to take Default or ""@"" to Delete" G N1A
- S $P(P(LN,SP),"^",5)=SP
- N2 ;
- S $P(P(LN,SP),"^",6)=MEAL
- N2A W !,"Quantity: ",$S($P(P(LN,SP),"^",4):$P(P(LN,SP),"^",4)_"// ",1:"1// ") R NUM:DTIME S:NUM="" NUM=$S($P(P(LN,SP),"^",4):$P(P(LN,SP),"^",4),1:1) G:'$T!(NUM="^") KIL
- I NUM="@" S $P(P(LN,SP),"^",4)="" G N2A
- I NUM'?1N!(NUM<1) W !,*7,"Enter a number from 1-9." G N2A
- S $P(P(LN,SP),"^",7)=NUM
- S C1=$P(P(LN,SP),"^",2,4),C2=$P(P(LN,SP),"^",5,7)
- Q:C1=C2
- N3 W !!,"ADD this Order? Y// " R YN:DTIME G:'$T!(YN="^") KIL S:YN="" YN="Y" S X=YN D TR^FH S YN=X I $P("YES",YN,1)'="",$P("NO",YN,1)'="" W *7," Answer YES or NO" G N3
- Q:YN?1"N".E
- I C1'="^^" S OLD=$P(P(LN,SP),"^",1),$P(^FHPT(FHDFN,"OP",ADM,"SP",OLD,0),"^",6,7)=NOW_"^"_DUZ K ^FHPT("ASPO",FHDFN,ADM,OLD) D
- .S DTP=$P($G(^FHPT(FHDFN,"OP",ADM,0)),U,1) D DTP^FH
- .S FHACT="O",FHTXT="Outpatient Standing Order: "_NUM_" "_$P($G(^FH(118.3,SP,0)),U,1)_" ("_MEAL_"), "_FHLOCN_", "_DTP D OPFILE^FHORX Q
- S $P(P(LN,SP),"^",2,4)="^^",$P(P(LN,SP),"^",2,4)=$P(P(LN,SP),"^",5,7),$P(P(LN,SP),"^",5,7)="^^"
- ADD ; Add SO
- F FHI=0:0 S FHI=$O(FHEDI(FHI)) Q:FHI'>0 S ADM=FHI D AD1
- D EVNT^FHSP1
- G E0
- AD1 L +^FHPT(FHDFN,"OP",ADM,"SP",0)
- S FHLOCN="" S:'$D(FHCNSOF) FHCNSOF=0
- S MEAL=$P($G(^FHPT(FHDFN,"OP",ADM,0)),U,4) Q:'$D(FHCK(MEAL))
- S FHLOC=$P($G(^(0)),U,3) I $G(FHLOC) S FHLOCN=$P($G(^FH(119.6,FHLOC,0)),U,1)
- I '$D(^FHPT(FHDFN,"OP",ADM,"SP",0)) S ^FHPT(FHDFN,"OP",ADM,"SP",0)="^115.1626^^"
- S X=^FHPT(FHDFN,"OP",ADM,"SP",0),NO=$P(X,"^",3)+1,^(0)=$P(X,"^",1,2)_"^"_NO_"^"_($P(X,"^",4)+1)
- L -^FHPT(FHDFN,"OP",ADM,"SP",0) I $D(^FHPT(FHDFN,"OP",ADM,"SP",NO)) G AD1
- S ^FHPT(FHDFN,"OP",ADM,"SP",NO,0)=NO_"^"_SP_"^"_MEAL_"^"_NOW_"^"_DUZ_"^^^"_NUM,^FHPT("ASPO",FHDFN,ADM,NO)="",LS=LS_NO_","
- S $P(P(LN,SP),"^",1)=NO
- S DTP=$P($G(^FHPT(FHDFN,"OP",ADM,0)),U,1) D DTP^FH S FHCNSOF=FHCNSOF+1 S:FHCNSOF=1 FHDTP=DTP
- Q
- SO2 ; SO Inquiry
- Q:'$G(ADM)
- S ALL=1 D ^FHOMDPA G:'FHDFN KIL S NO=0 D LIS G SO2
- SO3 ; Cancel SO
- S (FHLOCN,FHDTP)="" S:'$D(FHCNSOF) FHCNSOF=0
- F FHI=0:0 S FHI=$O(FHEDI(FHI)) Q:FHI'>0 S ADM=FHI D
- .S MEAL=$P($G(^FHPT(FHDFN,"OP",ADM,0)),U,4) Q:'$D(FHCK(MEAL))
- .S FHLOCN=""
- .S FHLOC=$P($G(^FHPT(FHDFN,"OP",ADM,0)),U,3) I $G(FHLOC) S FHLOCN=$P($G(^FH(119.6,FHLOC,0)),U,1)
- .F FHJ=0:0 S FHJ=$O(^FHPT(FHDFN,"OP",ADM,"SP",FHJ)) Q:FHJ'>0 D
- ..S SPD=$P($G(^FHPT(FHDFN,"OP",ADM,"SP",FHJ,0)),U,2)
- ..S NO=""
- ..I SP=SPD,$P($G(^FHPT(FHDFN,"OP",ADM,"SP",FHJ,0)),U,6)="" S NO=FHJ
- ..Q:'NO
- ..S $P(^FHPT(FHDFN,"OP",ADM,"SP",NO,0),"^",6,7)=NOW_"^"_DUZ
- ..S X=^FHPT(FHDFN,"OP",ADM,"SP",NO,0),SP=$P(X,"^",2),MEAL=$P(X,"^",3),NUM=$P(X,"^",8)
- ..K ^FHPT("ASPO",FHDFN,ADM,NO),P(LN,SP)
- ..S DTP=$P($G(^FHPT(FHDFN,"OP",ADM,0)),U,1) D DTP^FH S FHDTP=DTP
- S:'$D(FHDTP) FHDTP=DT
- I $D(FHDT1) S DTP=FHDT1 D DTP^FH S FHDTP=DTP
- I $D(FHDT2) S DTP=FHDT2 D DTP^FH S:FHDTP'=DTP FHDTP=FHDTP_" to "_DTP
- S FHACT="C",FHTXT="Outpatient Standing Order: "_$P($G(^FH(118.3,SP,0)),U,1)_" ("_FHALML_"), "_FHLOCN_", Cancelled "_FHDTP D OPFILE^FHORX
- Q
- LIS ;list outpt SO
- Q:'$G(ADM)
- D PATNAME^FHOMUTL
- S FHDATA0=$G(^FHPT(FHDFN,"OP",ADM,0))
- S DTP=$P(FHDATA0,U,1) D DTP^FH S FHDTST=DTP
- S NAM=FHPTNM,Y="",(FHDIETP,FHDIET,WARD)=""
- S FHDIET=$P(FHDATA0,U,2) I $D(^FH(119.6,$P(FHDATA0,U,3),0)) S WARD=$P(^FH(119.6,$P(FHDATA0,U,3),0),U,1)
- I $G(FHDIET) S Y=$P(^FH(111,FHDIET,0),U,1)
- I FHDIET="" S FHRNUM=ADM D DIETPAT^FHOMRR1 S:$D(FHDIETP) Y=FHDIETP
- W !!,NAM," " W:WARD'="" "( ",WARD," )" W:$D(FHDTST) ?40,"Date: ",FHDTST
- W !!,"Current Diet: ",$S(Y'="":Y,1:"No current order")
- D ALG^FHCLN W !," Allergies: ",$S(ALG="":"None on file",1:ALG)
- K N,P S CTR=0
- F K=0:0 S K=$O(^FHPT("ASPO",FHDFN,ADM,K)) Q:K<1 S X=^FHPT(FHDFN,"OP",ADM,"SP",K,0),M=$P(X,"^",3),M=$S(M="BNE":"A",1:$E(M,1)),N(M,K)=$P(X,"^",2,3)_"^"_$P(X,"^",8,9)
- S FHSOFG=1
- S LN=0,LS="" I $O(N(""))="" W !!,"No Active Outpatient Standing Orders." Q
- W !!,"Active Outpatient Standing Orders: ",!
- F M="A","B","N","E" D
- .F K=0:0 S K=$O(N(M,K)) Q:K<1 S Z=+N(M,K) I Z D
- ..S LN=LN+1,LS=LS_K_"," D L1 W ! W:NO $J(LN,2)
- ..S NUM=$P(N(M,K),"^",3)
- ..W ?5,M2,?18,$S(NUM:NUM,1:1)," ",$P(^FH(118.3,Z,0),"^",1)_$S($P(N(M,K),"^",4)'="Y":" (I)",1:"") I $G(^FH(118.3,Z,"I"))="Y" W " (** INACTIVE **)"
- ..S P(LN,+Z)=K_"^"_$P(N(M,K),"^",1,3) Q
- Q
- L1 ; Store SO
- S M1=$P(N(M,K),"^",2) I M1="BNE" S M2="All Meals" Q
- S L=$E(M1,1),M2=$S(L="B":"Break",L="N":"Noon",1:"Even")
- S L=$E(M1,2) Q:L="" S M2=M2_","_$S(L="B":"Break",L="N":"Noon",1:"Even") Q
- Q
- KIL G KILL^XUSCLEAN
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFHSP 9988 printed Feb 18, 2025@23:21:27 Page 2
- FHSP ; HISC/REL/NCA - Standing Orders ;2/13/95 14:30
- +1 ;;5.5;DIETETICS;**5,8**;Jan 28, 2005;Build 28
- EN1 ; Enter/Edit Standing Orders
- +1 KILL DIC
- WRITE !
- SET (DIC,DIE)="^FH(118.3,"
- SET DIC(0)="AEQLM"
- SET DIC("DR")=".01"
- SET DLAYGO=118.3
- WRITE !
- DO ^DIC
- KILL DIC,DLAYGO
- if U[X!$DATA(DTOUT)
- GOTO KIL
- if Y<1
- GOTO EN1
- +2 SET DA=+Y
- SET DR=".01:99"
- if $DATA(^XUSEC("FHMGR",DUZ))
- SET DIDEL=118.3
- DO ^DIE
- KILL DA,DIE,DIDEL,DR
- GOTO EN1
- EN2 ; List Standing Orders
- +1 WRITE !
- SET L=0
- SET DIC="^FH(118.3,"
- SET FLDS=".01,99,1"
- SET BY="NAME"
- +2 SET FR=""
- SET TO=""
- SET DHD="STANDING ORDERS"
- DO EN1^DIP
- +3 KILL %ZIS
- SET IOP=""
- DO ^%ZIS
- GOTO KIL
- SO ;OutPT SO
- +1 SET FHSOOP=$ORDER(^FHPT(FHDFN,"OP","B",DT-1))
- +2 IF '$DATA(^FHPT(FHDFN,"OP"))!'$GET(FHSOOP)
- WRITE !!,"** NO OUTPATIENT DATA ON FILE! Please enter outpatient meals from Recurring Meals Menu [FHOMRMGR]."
- QUIT
- +3 WRITE @IOF,!,"Outpatient Recurring Meals... "
- A0 ;Rec Meal entry.
- +1 KILL FHDM14,FHEDI,FHEDIF,FHIEN,FHMIEN,FHFLG,FHCK
- +2 SET FHQ=0
- +3 SET (FHTOTML("B"),FHTOTML("N"),FHTOTML("E"),FHTOTML("A"))=0
- +4 FOR FHI=DT-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 FHDM14(FHI,$PIECE(FHDA15,U,4))=FHI_U_FHJ
- +7 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
- +8 SET Y=$PIECE(FHDA15,U,1)
- XECUTE ^DD("DD")
- SET DTP=Y
- +9 SET (FHCOFLG,FHDATL)=0
- +10 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
- +11 WRITE !,DTP,?12,FH11,":"
- +12 SET FHDATL=$LENGTH(DTP)+13+$LENGTH(FH11)
- +13 FOR FHSF=0:0
- SET FHSF=$ORDER(^FHPT(FHDFN,"OP",FHJ,"SP",FHSF))
- if FHSF'>0
- QUIT
- Begin DoDot:2
- +14 SET FHDA15SF=$GET(^FHPT(FHDFN,"OP",FHJ,"SP",FHSF,0))
- +15 if $PIECE(FHDA15SF,U,6)
- QUIT
- +16 SET FHDASFNM=$PIECE($GET(^FH(118.3,$PIECE(FHDA15SF,U,2),0)),U,1)
- SET FHDASFQT=$PIECE(FHDA15SF,U,8)
- +17 IF (FHDATL+$LENGTH(FHDASFNM)+3+$LENGTH(FHDASFQT))>79
- WRITE !,?19
- SET FHDATL=19
- +18 IF (FHDATL>19)
- IF (FHCOFLG=1)
- WRITE ","
- +19 SET FHDATL=FHDATL+4+$LENGTH(FHDASFNM)+3+$LENGTH(FHDASFQT)
- +20 WRITE " ",FHDASFNM," = ",FHDASFQT
- +21 SET FHCOFLG=1
- End DoDot:2
- End DoDot:1
- +22 FOR FHI=0:0
- SET FHI=$ORDER(FHDM14(FHI))
- if FHI'>0
- QUIT
- Begin DoDot:1
- +23 FOR FHJ="B","N","E"
- if FHJ=""
- QUIT
- Begin DoDot:2
- +24 IF (FHJ="B")&$DATA(FHDM14(FHI,FHJ))
- SET FHTOTML("B")=FHTOTML("B")+1
- SET FHIEN(FHJ)=FHDM14(FHI,FHJ)
- +25 IF (FHJ="N")&$DATA(FHDM14(FHI,FHJ))
- SET FHTOTML("N")=FHTOTML("N")+1
- SET FHIEN(FHJ)=FHDM14(FHI,FHJ)
- +26 IF (FHJ="E")&$DATA(FHDM14(FHI,FHJ))
- SET FHTOTML("E")=FHTOTML("E")+1
- SET FHIEN(FHJ)=FHDM14(FHI,FHJ)
- End DoDot:2
- End DoDot:1
- +27 IF '$DATA(FHDM14)
- WRITE !!,"NO OUTPATIENT DATA ON FILE for today's date and the future!!",!
- QUIT
- +28 ;
- R1 SET (FHCNSOF,FH1,FHQ)=0
- SET (FHDTML,FHX,FHALML)=""
- READ !!,"Enter a Meal (B,N,E or ALL): ALL// ",FHDTML:DTIME
- +1 if '$TEST!(FHDTML["^")
- QUIT
- +2 if FHDTML=""
- SET FHDTML="ALL"
- +3 IF FHDTML["?"
- SET FHQ=1
- GOTO MS1
- +4 SET X=FHDTML
- DO TR^FH
- SET (FHX,FHDTML)=X
- +5 IF FHDTML="A"
- SET FHQ=1
- GOTO MS1
- +6 SET FHALML=FHX
- +7 IF FHDTML="ALL"
- SET FHDTML=$EXTRACT(FHDTML,1)
- SET FHALML="BNE"
- +8 IF $LENGTH(FHDTML)=3
- if ("BNE")'[$EXTRACT(FHDTML,1)
- SET FHQ=1
- if ("BNE")'[$EXTRACT(FHDTML,2)
- SET FHQ=1
- if ("BNE")'[$EXTRACT(FHDTML,3)
- SET FHQ=1
- SET FHCK($EXTRACT(FHDTML,1))=""
- SET FHCK($EXTRACT(FHDTML,2))=""
- SET FHCK($EXTRACT(FHDTML,3))=""
- +9 IF $LENGTH(FHDTML)=2
- if ("BNE")'[$EXTRACT(FHDTML,1)
- SET FHQ=1
- if ("BNE")'[$EXTRACT(FHDTML,2)
- SET FHQ=1
- SET FHCK($EXTRACT(FHDTML,1))=""
- SET FHCK($EXTRACT(FHDTML,2))=""
- +10 IF $LENGTH(FHDTML)=1
- if ("ABNE")'[$EXTRACT(FHDTML,1)
- SET FHQ=1
- SET FHCK(FHDTML)=""
- +11 IF FHDTML="A"
- SET (FHCK("B"),FHCK("N"),FHCK("E"))=""
- +12 if $LENGTH(FHDTML)>3
- SET FHQ=1
- +13 if FHQ
- GOTO MS1
- +14 IF $LENGTH(FHDTML)=3
- if '$GET(FHTOTML($EXTRACT(FHDTML,1)))
- SET FH1=1
- if '$GET(FHTOTML($EXTRACT(FHDTML,2)))
- SET FH1=1
- if '$GET(FHTOTML($EXTRACT(FHDTML,3)))
- SET FH1=1
- IF FH1
- WRITE !!,"There is no outpatient data for this Meal!!"
- GOTO R1
- +15 IF $LENGTH(FHDTML)=2
- if '$GET(FHTOTML($EXTRACT(FHDTML,1)))
- SET FH1=1
- if '$GET(FHTOTML($EXTRACT(FHDTML,2)))
- SET FH1=1
- IF FH1
- WRITE !!,"There is no outpatient data for this Meal!!"
- GOTO R1
- MS1 IF FHQ
- WRITE *7,!,"Select B for Breakfast, N for Noon, E for Evening or ALL for all meals",!,"Answer may be multiple meals, e.g., BN or NE"
- GOTO R1
- +1 if $LENGTH(FHDTML)>1
- SET FHDTML="A"
- +2 SET FHLIS=0
- +3 IF (FHDTML'="A")
- IF (FHTOTML(FHDTML)'>0)
- WRITE !!,"There is no outpatient data for this Meal!!"
- GOTO R1
- +4 IF FHDTML'="A"
- IF (FHTOTML(FHDTML)=1)
- SET FHEDI($PIECE(FHIEN(FHDTML),U,2))=""
- GOTO E0
- +5 IF FHDTML="A"
- GOTO ALL
- +6 ;quit dates are not entered for range.
- IF FHDTML'="A"
- IF (FHTOTML(FHDTML)>1)
- DO CHK^FHSPED
- if '$GET(FHFLG)
- QUIT
- +7 IF $GET(FHFLG)
- FOR FHI=FHDT1-1:0
- SET FHI=$ORDER(FHDM14(FHI))
- if (FHI'>0)!(FHI>FHDT2)
- QUIT
- if $DATA(FHDM14(FHI,FHDTML))
- SET FHEDI($PIECE(FHDM14(FHI,FHDTML),U,2))=""
- +8 GOTO E0
- ALL SET FHCT=0
- SET (FHDT1,FHDT2,FHDTSV)=DT
- FOR FHI=DT-1:0
- SET FHI=$ORDER(FHDM14(FHI))
- if 'FHI
- SET FHDT2=FHDTSV
- if FHI'>0
- QUIT
- SET FHCT=FHCT+1
- SET FHDTSV=FHI
- if FHCT=1
- SET FHDT1=FHI
- SET FHJ=""
- FOR
- SET FHJ=$ORDER(FHDM14(FHI,FHJ))
- if FHJ=""
- QUIT
- SET FHEDI($PIECE(FHDM14(FHI,FHJ),U,2))=""
- E0 SET ADM=0
- E1 WRITE !
- SET FHLOCN=""
- SET ADM=$ORDER(FHEDI(ADM))
- if 'ADM
- QUIT
- SET NO=1
- SET MEAL=$PIECE($GET(^FHPT(FHDFN,"OP",ADM,0)),U,4)
- SET FHLOC=$PIECE($GET(^(0)),U,3)
- +1 IF FHX'="ALL"
- IF FHX'[MEAL
- GOTO E1
- +2 IF $GET(FHLOC)
- SET FHLOCN=$PIECE($GET(^FH(119.6,FHLOC,0)),U,1)
- +3 DO LIS
- if 'LN
- GOTO N1
- +4 KILL DIR
- WRITE !
- SET DIR(0)="YA"
- SET DIR("A")="Edit a Standing Order? "
- SET DIR("B")="YES"
- DO ^DIR
- KILL DIR
- if $DATA(DIRUT)!$DATA(DIROUT)
- QUIT
- if Y<1
- GOTO N1
- N0 READ !!,"Edit which Order #? ",X:DTIME
- if '$TEST!("^"[X)
- QUIT
- IF X'?1N.N!(X<1)!(X>LN)
- WRITE *7," Enter # of Order to Edit"
- GOTO N0
- +1 SET SP=$PIECE(LS,",",+X)
- SET SP=$PIECE($GET(^FHPT(FHDFN,"OP",ADM,"SP",+SP,0)),"^",2)
- IF $DATA(P(+X,SP))
- SET LN=+X
- GOTO N1A
- +2 WRITE !!,"Standing Order ",$PIECE($GET(^FH(118.3,+SP,0)),"^",1)," added"
- SET LN=LN+1
- SET P(LN,SP)=""
- GOTO N1A
- N1 KILL DIC
- WRITE !
- SET DIC="^FH(118.3,"
- SET DIC("A")="Enter Standing Order: "
- SET DIC(0)="AEQM"
- +1 DO ^DIC
- KILL DIC,DLAYGO
- if "^"[X!$DATA(DTOUT)
- QUIT
- if Y<1
- GOTO SO
- SET SP=+Y
- +2 WRITE !!,"Standing Order ",$PIECE($GET(^FH(118.3,+SP,0)),"^",1)," added"
- +3 SET LN=LN+1
- SET P(LN,SP)=""
- N1A WRITE !,"Standing Order: ",$PIECE($GET(^FH(118.3,+SP,0)),"^",1)_" // "
- READ X:DTIME
- if '$TEST
- GOTO KIL
- +1 IF X="^"
- GOTO E0
- +2 IF X="@"
- DO SO3
- WRITE " .. Done"
- GOTO E0
- +3 IF X'=""
- WRITE *7,!,"Press Return to take Default or ""@"" to Delete"
- GOTO N1A
- +4 SET $PIECE(P(LN,SP),"^",5)=SP
- N2 ;
- +1 SET $PIECE(P(LN,SP),"^",6)=MEAL
- N2A WRITE !,"Quantity: ",$SELECT($PIECE(P(LN,SP),"^",4):$PIECE(P(LN,SP),"^",4)_"// ",1:"1// ")
- READ NUM:DTIME
- if NUM=""
- SET NUM=$SELECT($PIECE(P(LN,SP),"^",4):$PIECE(P(LN,SP),"^",4),1:1)
- if '$TEST!(NUM="^")
- GOTO KIL
- +1 IF NUM="@"
- SET $PIECE(P(LN,SP),"^",4)=""
- GOTO N2A
- +2 IF NUM'?1N!(NUM<1)
- WRITE !,*7,"Enter a number from 1-9."
- GOTO N2A
- +3 SET $PIECE(P(LN,SP),"^",7)=NUM
- +4 SET C1=$PIECE(P(LN,SP),"^",2,4)
- SET C2=$PIECE(P(LN,SP),"^",5,7)
- +5 if C1=C2
- QUIT
- N3 WRITE !!,"ADD this Order? Y// "
- READ YN:DTIME
- if '$TEST!(YN="^")
- GOTO KIL
- if YN=""
- SET YN="Y"
- SET X=YN
- DO TR^FH
- SET YN=X
- IF $PIECE("YES",YN,1)'=""
- IF $PIECE("NO",YN,1)'=""
- WRITE *7," Answer YES or NO"
- GOTO N3
- +1 if YN?1"N".E
- QUIT
- +2 IF C1'="^^"
- SET OLD=$PIECE(P(LN,SP),"^",1)
- SET $PIECE(^FHPT(FHDFN,"OP",ADM,"SP",OLD,0),"^",6,7)=NOW_"^"_DUZ
- KILL ^FHPT("ASPO",FHDFN,ADM,OLD)
- Begin DoDot:1
- +3 SET DTP=$PIECE($GET(^FHPT(FHDFN,"OP",ADM,0)),U,1)
- DO DTP^FH
- +4 SET FHACT="O"
- SET FHTXT="Outpatient Standing Order: "_NUM_" "_$PIECE($GET(^FH(118.3,SP,0)),U,1)_" ("_MEAL_"), "_FHLOCN_", "_DTP
- DO OPFILE^FHORX
- QUIT
- End DoDot:1
- +5 SET $PIECE(P(LN,SP),"^",2,4)="^^"
- SET $PIECE(P(LN,SP),"^",2,4)=$PIECE(P(LN,SP),"^",5,7)
- SET $PIECE(P(LN,SP),"^",5,7)="^^"
- ADD ; Add SO
- +1 FOR FHI=0:0
- SET FHI=$ORDER(FHEDI(FHI))
- if FHI'>0
- QUIT
- SET ADM=FHI
- DO AD1
- +2 DO EVNT^FHSP1
- +3 GOTO E0
- AD1 LOCK +^FHPT(FHDFN,"OP",ADM,"SP",0)
- +1 SET FHLOCN=""
- if '$DATA(FHCNSOF)
- SET FHCNSOF=0
- +2 SET MEAL=$PIECE($GET(^FHPT(FHDFN,"OP",ADM,0)),U,4)
- if '$DATA(FHCK(MEAL))
- QUIT
- +3 SET FHLOC=$PIECE($GET(^(0)),U,3)
- IF $GET(FHLOC)
- SET FHLOCN=$PIECE($GET(^FH(119.6,FHLOC,0)),U,1)
- +4 IF '$DATA(^FHPT(FHDFN,"OP",ADM,"SP",0))
- SET ^FHPT(FHDFN,"OP",ADM,"SP",0)="^115.1626^^"
- +5 SET X=^FHPT(FHDFN,"OP",ADM,"SP",0)
- SET NO=$PIECE(X,"^",3)+1
- SET ^(0)=$PIECE(X,"^",1,2)_"^"_NO_"^"_($PIECE(X,"^",4)+1)
- +6 LOCK -^FHPT(FHDFN,"OP",ADM,"SP",0)
- IF $DATA(^FHPT(FHDFN,"OP",ADM,"SP",NO))
- GOTO AD1
- +7 SET ^FHPT(FHDFN,"OP",ADM,"SP",NO,0)=NO_"^"_SP_"^"_MEAL_"^"_NOW_"^"_DUZ_"^^^"_NUM
- SET ^FHPT("ASPO",FHDFN,ADM,NO)=""
- SET LS=LS_NO_","
- +8 SET $PIECE(P(LN,SP),"^",1)=NO
- +9 SET DTP=$PIECE($GET(^FHPT(FHDFN,"OP",ADM,0)),U,1)
- DO DTP^FH
- SET FHCNSOF=FHCNSOF+1
- if FHCNSOF=1
- SET FHDTP=DTP
- +10 QUIT
- SO2 ; SO Inquiry
- +1 if '$GET(ADM)
- QUIT
- +2 SET ALL=1
- DO ^FHOMDPA
- if 'FHDFN
- GOTO KIL
- SET NO=0
- DO LIS
- GOTO SO2
- SO3 ; Cancel SO
- +1 SET (FHLOCN,FHDTP)=""
- if '$DATA(FHCNSOF)
- SET FHCNSOF=0
- +2 FOR FHI=0:0
- SET FHI=$ORDER(FHEDI(FHI))
- if FHI'>0
- QUIT
- SET ADM=FHI
- Begin DoDot:1
- +3 SET MEAL=$PIECE($GET(^FHPT(FHDFN,"OP",ADM,0)),U,4)
- if '$DATA(FHCK(MEAL))
- QUIT
- +4 SET FHLOCN=""
- +5 SET FHLOC=$PIECE($GET(^FHPT(FHDFN,"OP",ADM,0)),U,3)
- IF $GET(FHLOC)
- SET FHLOCN=$PIECE($GET(^FH(119.6,FHLOC,0)),U,1)
- +6 FOR FHJ=0:0
- SET FHJ=$ORDER(^FHPT(FHDFN,"OP",ADM,"SP",FHJ))
- if FHJ'>0
- QUIT
- Begin DoDot:2
- +7 SET SPD=$PIECE($GET(^FHPT(FHDFN,"OP",ADM,"SP",FHJ,0)),U,2)
- +8 SET NO=""
- +9 IF SP=SPD
- IF $PIECE($GET(^FHPT(FHDFN,"OP",ADM,"SP",FHJ,0)),U,6)=""
- SET NO=FHJ
- +10 if 'NO
- QUIT
- +11 SET $PIECE(^FHPT(FHDFN,"OP",ADM,"SP",NO,0),"^",6,7)=NOW_"^"_DUZ
- +12 SET X=^FHPT(FHDFN,"OP",ADM,"SP",NO,0)
- SET SP=$PIECE(X,"^",2)
- SET MEAL=$PIECE(X,"^",3)
- SET NUM=$PIECE(X,"^",8)
- +13 KILL ^FHPT("ASPO",FHDFN,ADM,NO),P(LN,SP)
- +14 SET DTP=$PIECE($GET(^FHPT(FHDFN,"OP",ADM,0)),U,1)
- DO DTP^FH
- SET FHDTP=DTP
- End DoDot:2
- End DoDot:1
- +15 if '$DATA(FHDTP)
- SET FHDTP=DT
- +16 IF $DATA(FHDT1)
- SET DTP=FHDT1
- DO DTP^FH
- SET FHDTP=DTP
- +17 IF $DATA(FHDT2)
- SET DTP=FHDT2
- DO DTP^FH
- if FHDTP'=DTP
- SET FHDTP=FHDTP_" to "_DTP
- +18 SET FHACT="C"
- SET FHTXT="Outpatient Standing Order: "_$PIECE($GET(^FH(118.3,SP,0)),U,1)_" ("_FHALML_"), "_FHLOCN_", Cancelled "_FHDTP
- DO OPFILE^FHORX
- +19 QUIT
- LIS ;list outpt SO
- +1 if '$GET(ADM)
- QUIT
- +2 DO PATNAME^FHOMUTL
- +3 SET FHDATA0=$GET(^FHPT(FHDFN,"OP",ADM,0))
- +4 SET DTP=$PIECE(FHDATA0,U,1)
- DO DTP^FH
- SET FHDTST=DTP
- +5 SET NAM=FHPTNM
- SET Y=""
- SET (FHDIETP,FHDIET,WARD)=""
- +6 SET FHDIET=$PIECE(FHDATA0,U,2)
- IF $DATA(^FH(119.6,$PIECE(FHDATA0,U,3),0))
- SET WARD=$PIECE(^FH(119.6,$PIECE(FHDATA0,U,3),0),U,1)
- +7 IF $GET(FHDIET)
- SET Y=$PIECE(^FH(111,FHDIET,0),U,1)
- +8 IF FHDIET=""
- SET FHRNUM=ADM
- DO DIETPAT^FHOMRR1
- if $DATA(FHDIETP)
- SET Y=FHDIETP
- +9 WRITE !!,NAM," "
- if WARD'=""
- WRITE "( ",WARD," )"
- if $DATA(FHDTST)
- WRITE ?40,"Date: ",FHDTST
- +10 WRITE !!,"Current Diet: ",$SELECT(Y'="":Y,1:"No current order")
- +11 DO ALG^FHCLN
- WRITE !," Allergies: ",$SELECT(ALG="":"None on file",1:ALG)
- +12 KILL N,P
- SET CTR=0
- +13 FOR K=0:0
- SET K=$ORDER(^FHPT("ASPO",FHDFN,ADM,K))
- if K<1
- QUIT
- SET X=^FHPT(FHDFN,"OP",ADM,"SP",K,0)
- SET M=$PIECE(X,"^",3)
- SET M=$SELECT(M="BNE":"A",1:$EXTRACT(M,1))
- SET N(M,K)=$PIECE(X,"^",2,3)_"^"_$PIECE(X,"^",8,9)
- +14 SET FHSOFG=1
- +15 SET LN=0
- SET LS=""
- IF $ORDER(N(""))=""
- WRITE !!,"No Active Outpatient Standing Orders."
- QUIT
- +16 WRITE !!,"Active Outpatient Standing Orders: ",!
- +17 FOR M="A","B","N","E"
- Begin DoDot:1
- +18 FOR K=0:0
- SET K=$ORDER(N(M,K))
- if K<1
- QUIT
- SET Z=+N(M,K)
- IF Z
- Begin DoDot:2
- +19 SET LN=LN+1
- SET LS=LS_K_","
- DO L1
- WRITE !
- if NO
- WRITE $JUSTIFY(LN,2)
- +20 SET NUM=$PIECE(N(M,K),"^",3)
- +21 WRITE ?5,M2,?18,$SELECT(NUM:NUM,1:1)," ",$PIECE(^FH(118.3,Z,0),"^",1)_$SELECT($PIECE(N(M,K),"^",4)'="Y":" (I)",1:"")
- IF $GET(^FH(118.3,Z,"I"))="Y"
- WRITE " (** INACTIVE **)"
- +22 SET P(LN,+Z)=K_"^"_$PIECE(N(M,K),"^",1,3)
- QUIT
- End DoDot:2
- End DoDot:1
- +23 QUIT
- L1 ; Store SO
- +1 SET M1=$PIECE(N(M,K),"^",2)
- IF M1="BNE"
- SET M2="All Meals"
- QUIT
- +2 SET L=$EXTRACT(M1,1)
- SET M2=$SELECT(L="B":"Break",L="N":"Noon",1:"Even")
- +3 SET L=$EXTRACT(M1,2)
- if L=""
- QUIT
- SET M2=M2_","_$SELECT(L="B":"Break",L="N":"Noon",1:"Even")
- QUIT
- +4 QUIT
- KIL GOTO KILL^XUSCLEAN
