Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: FHSP

FHSP.m

Go to the documentation of this file.
  1. FHSP ; HISC/REL/NCA - Standing Orders ;2/13/95 14:30
  1. ;;5.5;DIETETICS;**5,8**;Jan 28, 2005;Build 28
  1. EN1 ; Enter/Edit Standing Orders
  1. 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
  1. S DA=+Y,DR=".01:99" S:$D(^XUSEC("FHMGR",DUZ)) DIDEL=118.3 D ^DIE K DA,DIE,DIDEL,DR G EN1
  1. EN2 ; List Standing Orders
  1. W ! S L=0,DIC="^FH(118.3,",FLDS=".01,99,1",BY="NAME"
  1. S FR="",TO="",DHD="STANDING ORDERS" D EN1^DIP
  1. K %ZIS S IOP="" D ^%ZIS G KIL
  1. SO ;OutPT SO
  1. S FHSOOP=$O(^FHPT(FHDFN,"OP","B",DT-1))
  1. I '$D(^FHPT(FHDFN,"OP"))!'$G(FHSOOP) W !!,"** NO OUTPATIENT DATA ON FILE! Please enter outpatient meals from Recurring Meals Menu [FHOMRMGR]." Q
  1. W @IOF,!,"Outpatient Recurring Meals... "
  1. A0 ;Rec Meal entry.
  1. K FHDM14,FHEDI,FHEDIF,FHIEN,FHMIEN,FHFLG,FHCK
  1. S FHQ=0
  1. S (FHTOTML("B"),FHTOTML("N"),FHTOTML("E"),FHTOTML("A"))=0
  1. 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
  1. .S FHDA15=$G(^FHPT(FHDFN,"OP",FHJ,0))
  1. .S FHDM14(FHI,$P(FHDA15,U,4))=FHI_U_FHJ
  1. .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
  1. .S Y=$P(FHDA15,U,1) X ^DD("DD") S DTP=Y
  1. .S (FHCOFLG,FHDATL)=0
  1. .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
  1. .W !,DTP,?12,FH11,":"
  1. .S FHDATL=$L(DTP)+13+$L(FH11)
  1. .F FHSF=0:0 S FHSF=$O(^FHPT(FHDFN,"OP",FHJ,"SP",FHSF)) Q:FHSF'>0 D
  1. ..S FHDA15SF=$G(^FHPT(FHDFN,"OP",FHJ,"SP",FHSF,0))
  1. ..Q:$P(FHDA15SF,U,6)
  1. ..S FHDASFNM=$P($G(^FH(118.3,$P(FHDA15SF,U,2),0)),U,1),FHDASFQT=$P(FHDA15SF,U,8)
  1. ..I (FHDATL+$L(FHDASFNM)+3+$L(FHDASFQT))>79 W !,?19 S FHDATL=19
  1. ..I (FHDATL>19),(FHCOFLG=1) W ","
  1. ..S FHDATL=FHDATL+4+$L(FHDASFNM)+3+$L(FHDASFQT)
  1. ..W " ",FHDASFNM," = ",FHDASFQT
  1. ..S FHCOFLG=1
  1. F FHI=0:0 S FHI=$O(FHDM14(FHI)) Q:FHI'>0 D
  1. .F FHJ="B","N","E" Q:FHJ="" D
  1. ..I (FHJ="B")&$D(FHDM14(FHI,FHJ)) S FHTOTML("B")=FHTOTML("B")+1,FHIEN(FHJ)=FHDM14(FHI,FHJ)
  1. ..I (FHJ="N")&$D(FHDM14(FHI,FHJ)) S FHTOTML("N")=FHTOTML("N")+1,FHIEN(FHJ)=FHDM14(FHI,FHJ)
  1. ..I (FHJ="E")&$D(FHDM14(FHI,FHJ)) S FHTOTML("E")=FHTOTML("E")+1,FHIEN(FHJ)=FHDM14(FHI,FHJ)
  1. I '$D(FHDM14) W !!,"NO OUTPATIENT DATA ON FILE for today's date and the future!!",! Q
  1. ;
  1. R1 S (FHCNSOF,FH1,FHQ)=0,(FHDTML,FHX,FHALML)="" R !!,"Enter a Meal (B,N,E or ALL): ALL// ",FHDTML:DTIME
  1. Q:'$T!(FHDTML["^")
  1. S:FHDTML="" FHDTML="ALL"
  1. I FHDTML["?" S FHQ=1 G MS1
  1. S X=FHDTML D TR^FH S (FHX,FHDTML)=X
  1. I FHDTML="A" S FHQ=1 G MS1
  1. S FHALML=FHX
  1. I FHDTML="ALL" S FHDTML=$E(FHDTML,1),FHALML="BNE"
  1. 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))=""
  1. 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))=""
  1. I $L(FHDTML)=1 S:("ABNE")'[$E(FHDTML,1) FHQ=1 S FHCK(FHDTML)=""
  1. I FHDTML="A" S (FHCK("B"),FHCK("N"),FHCK("E"))=""
  1. S:$L(FHDTML)>3 FHQ=1
  1. G:FHQ MS1
  1. 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
  1. 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
  1. 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
  1. S:$L(FHDTML)>1 FHDTML="A"
  1. S FHLIS=0
  1. I (FHDTML'="A"),(FHTOTML(FHDTML)'>0) W !!,"There is no outpatient data for this Meal!!" G R1
  1. I FHDTML'="A",(FHTOTML(FHDTML)=1) S FHEDI($P(FHIEN(FHDTML),U,2))="" G E0
  1. I FHDTML="A" G ALL
  1. I FHDTML'="A",(FHTOTML(FHDTML)>1) D CHK^FHSPED Q:'$G(FHFLG) ;quit dates are not entered for range.
  1. 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))=""
  1. G E0
  1. 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))=""
  1. E0 S ADM=0
  1. 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)
  1. I FHX'="ALL",FHX'[MEAL G E1
  1. I $G(FHLOC) S FHLOCN=$P($G(^FH(119.6,FHLOC,0)),U,1)
  1. D LIS G:'LN N1
  1. 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
  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
  1. 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
  1. W !!,"Standing Order ",$P($G(^FH(118.3,+SP,0)),"^",1)," added" S LN=LN+1,P(LN,SP)="" G N1A
  1. N1 K DIC W ! S DIC="^FH(118.3,",DIC("A")="Enter Standing Order: ",DIC(0)="AEQM"
  1. D ^DIC K DIC,DLAYGO Q:"^"[X!$D(DTOUT) G SO:Y<1 S SP=+Y
  1. W !!,"Standing Order ",$P($G(^FH(118.3,+SP,0)),"^",1)," added"
  1. S LN=LN+1,P(LN,SP)=""
  1. N1A W !,"Standing Order: ",$P($G(^FH(118.3,+SP,0)),"^",1)_" // " R X:DTIME G KIL:'$T
  1. I X="^" G E0
  1. I X="@" D SO3 W " .. Done" G E0
  1. I X'="" W *7,!,"Press Return to take Default or ""@"" to Delete" G N1A
  1. S $P(P(LN,SP),"^",5)=SP
  1. N2 ;
  1. S $P(P(LN,SP),"^",6)=MEAL
  1. 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
  1. I NUM="@" S $P(P(LN,SP),"^",4)="" G N2A
  1. I NUM'?1N!(NUM<1) W !,*7,"Enter a number from 1-9." G N2A
  1. S $P(P(LN,SP),"^",7)=NUM
  1. S C1=$P(P(LN,SP),"^",2,4),C2=$P(P(LN,SP),"^",5,7)
  1. Q:C1=C2
  1. 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
  1. Q:YN?1"N".E
  1. 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
  1. .S DTP=$P($G(^FHPT(FHDFN,"OP",ADM,0)),U,1) D DTP^FH
  1. .S FHACT="O",FHTXT="Outpatient Standing Order: "_NUM_" "_$P($G(^FH(118.3,SP,0)),U,1)_" ("_MEAL_"), "_FHLOCN_", "_DTP D OPFILE^FHORX Q
  1. 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)="^^"
  1. ADD ; Add SO
  1. F FHI=0:0 S FHI=$O(FHEDI(FHI)) Q:FHI'>0 S ADM=FHI D AD1
  1. D EVNT^FHSP1
  1. G E0
  1. AD1 L +^FHPT(FHDFN,"OP",ADM,"SP",0)
  1. S FHLOCN="" S:'$D(FHCNSOF) FHCNSOF=0
  1. S MEAL=$P($G(^FHPT(FHDFN,"OP",ADM,0)),U,4) Q:'$D(FHCK(MEAL))
  1. S FHLOC=$P($G(^(0)),U,3) I $G(FHLOC) S FHLOCN=$P($G(^FH(119.6,FHLOC,0)),U,1)
  1. I '$D(^FHPT(FHDFN,"OP",ADM,"SP",0)) S ^FHPT(FHDFN,"OP",ADM,"SP",0)="^115.1626^^"
  1. S X=^FHPT(FHDFN,"OP",ADM,"SP",0),NO=$P(X,"^",3)+1,^(0)=$P(X,"^",1,2)_"^"_NO_"^"_($P(X,"^",4)+1)
  1. L -^FHPT(FHDFN,"OP",ADM,"SP",0) I $D(^FHPT(FHDFN,"OP",ADM,"SP",NO)) G AD1
  1. S ^FHPT(FHDFN,"OP",ADM,"SP",NO,0)=NO_"^"_SP_"^"_MEAL_"^"_NOW_"^"_DUZ_"^^^"_NUM,^FHPT("ASPO",FHDFN,ADM,NO)="",LS=LS_NO_","
  1. S $P(P(LN,SP),"^",1)=NO
  1. S DTP=$P($G(^FHPT(FHDFN,"OP",ADM,0)),U,1) D DTP^FH S FHCNSOF=FHCNSOF+1 S:FHCNSOF=1 FHDTP=DTP
  1. Q
  1. SO2 ; SO Inquiry
  1. Q:'$G(ADM)
  1. S ALL=1 D ^FHOMDPA G:'FHDFN KIL S NO=0 D LIS G SO2
  1. SO3 ; Cancel SO
  1. S (FHLOCN,FHDTP)="" S:'$D(FHCNSOF) FHCNSOF=0
  1. F FHI=0:0 S FHI=$O(FHEDI(FHI)) Q:FHI'>0 S ADM=FHI D
  1. .S MEAL=$P($G(^FHPT(FHDFN,"OP",ADM,0)),U,4) Q:'$D(FHCK(MEAL))
  1. .S FHLOCN=""
  1. .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)
  1. .F FHJ=0:0 S FHJ=$O(^FHPT(FHDFN,"OP",ADM,"SP",FHJ)) Q:FHJ'>0 D
  1. ..S SPD=$P($G(^FHPT(FHDFN,"OP",ADM,"SP",FHJ,0)),U,2)
  1. ..S NO=""
  1. ..I SP=SPD,$P($G(^FHPT(FHDFN,"OP",ADM,"SP",FHJ,0)),U,6)="" S NO=FHJ
  1. ..Q:'NO
  1. ..S $P(^FHPT(FHDFN,"OP",ADM,"SP",NO,0),"^",6,7)=NOW_"^"_DUZ
  1. ..S X=^FHPT(FHDFN,"OP",ADM,"SP",NO,0),SP=$P(X,"^",2),MEAL=$P(X,"^",3),NUM=$P(X,"^",8)
  1. ..K ^FHPT("ASPO",FHDFN,ADM,NO),P(LN,SP)
  1. ..S DTP=$P($G(^FHPT(FHDFN,"OP",ADM,0)),U,1) D DTP^FH S FHDTP=DTP
  1. S:'$D(FHDTP) FHDTP=DT
  1. I $D(FHDT1) S DTP=FHDT1 D DTP^FH S FHDTP=DTP
  1. I $D(FHDT2) S DTP=FHDT2 D DTP^FH S:FHDTP'=DTP FHDTP=FHDTP_" to "_DTP
  1. S FHACT="C",FHTXT="Outpatient Standing Order: "_$P($G(^FH(118.3,SP,0)),U,1)_" ("_FHALML_"), "_FHLOCN_", Cancelled "_FHDTP D OPFILE^FHORX
  1. Q
  1. LIS ;list outpt SO
  1. Q:'$G(ADM)
  1. D PATNAME^FHOMUTL
  1. S FHDATA0=$G(^FHPT(FHDFN,"OP",ADM,0))
  1. S DTP=$P(FHDATA0,U,1) D DTP^FH S FHDTST=DTP
  1. S NAM=FHPTNM,Y="",(FHDIETP,FHDIET,WARD)=""
  1. 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)
  1. I $G(FHDIET) S Y=$P(^FH(111,FHDIET,0),U,1)
  1. I FHDIET="" S FHRNUM=ADM D DIETPAT^FHOMRR1 S:$D(FHDIETP) Y=FHDIETP
  1. W !!,NAM," " W:WARD'="" "( ",WARD," )" W:$D(FHDTST) ?40,"Date: ",FHDTST
  1. W !!,"Current Diet: ",$S(Y'="":Y,1:"No current order")
  1. D ALG^FHCLN W !," Allergies: ",$S(ALG="":"None on file",1:ALG)
  1. K N,P S CTR=0
  1. 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)
  1. S FHSOFG=1
  1. S LN=0,LS="" I $O(N(""))="" W !!,"No Active Outpatient Standing Orders." Q
  1. W !!,"Active Outpatient Standing Orders: ",!
  1. F M="A","B","N","E" D
  1. .F K=0:0 S K=$O(N(M,K)) Q:K<1 S Z=+N(M,K) I Z D
  1. ..S LN=LN+1,LS=LS_K_"," D L1 W ! W:NO $J(LN,2)
  1. ..S NUM=$P(N(M,K),"^",3)
  1. ..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 **)"
  1. ..S P(LN,+Z)=K_"^"_$P(N(M,K),"^",1,3) Q
  1. Q
  1. L1 ; Store SO
  1. S M1=$P(N(M,K),"^",2) I M1="BNE" S M2="All Meals" Q
  1. S L=$E(M1,1),M2=$S(L="B":"Break",L="N":"Noon",1:"Even")
  1. S L=$E(M1,2) Q:L="" S M2=M2_","_$S(L="B":"Break",L="N":"Noon",1:"Even") Q
  1. Q
  1. KIL G KILL^XUSCLEAN