| 1 | FHWOR3 ; HISC/NCA - HL7 Early/Late Tray ;10/10/00 14:56
|
---|
| 2 | ;;5.5;DIETETICS;;Jan 28, 2005
|
---|
| 3 | S DATA=X
|
---|
| 4 | N BAG,CODE,DATE,DAY,DTE,DP,EL,K,L1,LP,LSTWD,MEAL,PER,PIECE,SERV,SP,W1,WKD,WKDAYS,Y
|
---|
| 5 | S:ITVL="" ITVL="ONCE"
|
---|
| 6 | I 'SDT S TXT="No Start Date." D ERR^FHWOR Q
|
---|
| 7 | S DATE=SDT D CVT^FHWOR S SDT=DATE\1
|
---|
| 8 | I EDT S DATE=EDT D CVT^FHWOR S EDT=DATE\1
|
---|
| 9 | I 'EDT S:ITVL="ONCE" EDT=SDT I 'EDT S TXT="No Stop Date." D ERR^FHWOR Q
|
---|
| 10 | S SERV=$P(DATA,"|",2)
|
---|
| 11 | I $P("EARLY",SERV,1)'="",$P("LATE",SERV,1)'="" S TXT="Wrong Type of Tray." D ERR^FHWOR Q
|
---|
| 12 | S PER=$P(DATA,"|",3),PER=$E(PER,4,$L(PER)),MEAL=$E(PER,1) I "BNE"'[MEAL S TXT="Wrong Service Period." D ERR^FHWOR Q
|
---|
| 13 | I $E(PER,2)'=$E(SERV,1) S TXT="Wrong Service Period." D ERR^FHWOR Q
|
---|
| 14 | S PIECE=$E(PER,3) I 'PIECE S TXT="No Time Specified." D ERR^FHWOR Q
|
---|
| 15 | S K=$S(MEAL="B":0,MEAL="N":6,1:12)+($E(PER,2)="L"*3)
|
---|
| 16 | S W1=$P($G(^FHPT(FHDFN,"A",ADM,0)),"^",8),DP=$P($G(^FH(119.6,+W1,0)),"^",8)
|
---|
| 17 | K TM F L1=1:1:3 S TM(L1)=$P($G(^FH(119.73,+DP,1)),"^",K+L1)
|
---|
| 18 | S TIM=TM(PIECE) I TIM="" F L1=1:1:3 S:TM(L1)'="" TIM=TM(L1)
|
---|
| 19 | I TIM="" S TXT="No Early/Late Time on file." D ERR^FHWOR Q
|
---|
| 20 | S BAG="N" I $P(X,"|",4)="bagged" S BAG="Y"
|
---|
| 21 | S X=SDT_"@"_TIM,%DT="XT" D ^%DT S (SDT,FHDTIM)=Y,EDT=EDT+(SDT#1)
|
---|
| 22 | S (FHV1,FHV2)="" D CUR^FHWOR31(FHDFN,ADM,FHDTIM,.FHV1,.FHV2)
|
---|
| 23 | S (WKDAYS,WKD)=""
|
---|
| 24 | I SDT=EDT D G:SP ERR G PROC
|
---|
| 25 | .S SP="" F K=SDT\1:0 S K=$O(^FHPT(FHDFN,"A",ADM,"EL",K)) Q:K<1!(K\1'=(SDT\1)) I $P(^(K,0),"^",2)=MEAL S SP=K Q
|
---|
| 26 | .I SP S TXT="Early/Late Meal Already Ordered for this Date." Q
|
---|
| 27 | .Q
|
---|
| 28 | F LP=1:1 S CODE=$P(ITVL,"~",LP) Q:CODE="" D Q:TXT'=""
|
---|
| 29 | .I CODE="ONCE" S TXT="ONCE is for one Day Only." Q
|
---|
| 30 | .I $E(CODE,1)'="Q" S TXT="Wrong Interval specification. Use Only ONCE, QJ#, or Q1J#." Q
|
---|
| 31 | .I +$E(CODE,2)>1 S TXT="Wrong interval specification. Use Only ONCE, QJ#, or Q1J#." Q
|
---|
| 32 | .S LSTWD=$E(CODE,$L(CODE))
|
---|
| 33 | .I LSTWD="J" S DAY=1 S WKD=WKD_$E("MTWRFSX",DAY) Q
|
---|
| 34 | .I LSTWD?1N,$E(CODE,$L(CODE)-1)="J" D Q
|
---|
| 35 | ..S DAY=LSTWD I DAY<1!(DAY>7) S TXT="Wrong Day Specification." Q
|
---|
| 36 | ..S WKD=WKD_$E("MTWRFSX",DAY),WKDAYS=WKDAYS_DAY Q
|
---|
| 37 | .S TXT="Wrong interval specification. Use Only ONCE, QJ#, or Q1J#."
|
---|
| 38 | .Q
|
---|
| 39 | I TXT'="" D ERR^FHWOR Q
|
---|
| 40 | PROC ; Process Add E/L Trays
|
---|
| 41 | D PROC^FHWOR31
|
---|
| 42 | EXIT ; Exit Process Kill.
|
---|
| 43 | K %,%H,%I,%DT,BAG,CODE,DATE,DAY,DTE,DP,EL,FHDAY,FHDTIM,FHV1,FHV2,K,L1,LP,LSTWD,MEAL,PER,PIECE,SERV,SP,W1,WKD,WKDAYS,X,Y Q
|
---|
| 44 | ERR ; Send Error Message
|
---|
| 45 | D ERR^FHWOR Q
|
---|
| 46 | CAN ; Process Cancel/Discontinue from OE/RR
|
---|
| 47 | D NOW^%DTC S NOW=%,CT=0
|
---|
| 48 | D GADM^FHWORR
|
---|
| 49 | F EL=%:0 S EL=$O(^FHPT(FHDFN,"A",+ADM,"EL",EL)) Q:EL<1!(EL>$P(FILL,";",5)) S X=$G(^(EL,0)) I $P(X,"^",7)=+FHORN K ^FHPT(FHDFN,"A",ADM,"EL",EL),^FHPT("ADLT",EL,FHDFN) S CT=CT+1
|
---|
| 50 | S %=$S($D(^FHPT(FHDFN,"A",ADM,"EL",0)):$P(^(0),"^",4),1:0)-CT S:%'<0 $P(^(0),"^",4)=%
|
---|
| 51 | K %,%H,%I,CT,EL D CSEND^FHWOR Q
|
---|
| 52 | EL ; Code Early Late Tray
|
---|
| 53 | K MSG S WKDAYS=""
|
---|
| 54 | I SDT=EDT S ITVL="ONCE" G EL1
|
---|
| 55 | S ITVL="" F K=1:1 S Z=$E(WKD,K) Q:Z="" S DAY=$F("MTWRFSX",Z),DAY=DAY-1 S:ITVL'="" ITVL=ITVL_"~" S ITVL=ITVL_"QJ"_DAY,WKDAYS=WKDAYS_DAY
|
---|
| 56 | EL1 S FILL="E"_";"_ADM_";;"_SDT_";"_EDT_";"_WKD_";"_MEAL_";"_TIM_";"_BAG
|
---|
| 57 | D SET
|
---|
| 58 | ; Code MSH, PID, and PV1
|
---|
| 59 | D MSH^FHWOR
|
---|
| 60 | ; code ORC
|
---|
| 61 | S MSG(4)="ORC|SN||"_FILL_"^FH||||^"_ITVL_"^^"_SDT_"^"_EDT_"|||"_DUZ_"||"_DUZ_"|||"_NOW
|
---|
| 62 | ; code ODT
|
---|
| 63 | S MSG(5)="ODT|"_$S(SERV="E":"EARLY",1:"LATE")_"|^^^"_MEAL_SERV_NUM_"^^99FHS|"_$S(BAG="Y":"bagged",1:"")
|
---|
| 64 | K FHWARD,FILL,HOSP,ITVL,FHORN,RM,SITE,WARD,WKDAYS,Z Q
|
---|
| 65 | CODE ; Code Cancel/Discontinue Early Late Tray
|
---|
| 66 | K MSG S ACT="OC",WKD="",CTR=0 D SITE^FH
|
---|
| 67 | S EDT="" F SK=0:0 S SK=$O(NN(FHORN,SK)) Q:SK<1 S CTR=CTR+1 S:CTR=1 SDT=SK S EDT=SK D WKD
|
---|
| 68 | S STR=$G(^FHPT(FHDFN,"A",ADM,"EL",EDT,0))
|
---|
| 69 | S FILL="E"_";"_ADM_";;"_SDT_";"_EDT_";"_WKD_";"_$P(STR,"^",2)_";"_$P(STR,"^",3)_";"_$P(STR,"^",4)
|
---|
| 70 | ; code MSH
|
---|
| 71 | S MSG(1)="MSH|^~\&|DIETETICS|"_SITE(1)_"|||||ORM"
|
---|
| 72 | ; code PID
|
---|
| 73 | S MSG(2)="PID|||"_DFN_"||"_$P($G(^DPT(DFN,0)),"^",1)
|
---|
| 74 | ; code ORC
|
---|
| 75 | S DATE=$$FMTHL7^XLFDT(NOW)
|
---|
| 76 | S MSG(3)="ORC|"_ACT_"|"_FHORN_"^OR|"_FILL_"^FH|||||||||"_FHPV_"|||"_DATE_"|Dietetics Canceled Early/Late Tray order."
|
---|
| 77 | K %,%Y,ACT,DATE,EDT,FILL,FHORN,SDT,SK,SITE,STR,WKD Q
|
---|
| 78 | WKD ; Get week days
|
---|
| 79 | D WKD^FHWOR31
|
---|
| 80 | Q
|
---|
| 81 | SET ; Set Date/Time in HL7 format
|
---|
| 82 | D SET^FHWOR31
|
---|
| 83 | Q
|
---|
| 84 | NA ; OE/RR Number Assign
|
---|
| 85 | S SDT=$P(FILL,";",4),EDT=$P(FILL,";",5),WKD=$P(FILL,";",6),MEAL=$P(FILL,";",7),TIM=$P(FILL,";",8),DTE=SDT
|
---|
| 86 | G:'+FHORN KIL
|
---|
| 87 | G:'$D(^FHPT(FHDFN,"A",ADM,"EL",SDT,0)) KIL
|
---|
| 88 | I WKD="" S $P(^FHPT(FHDFN,"A",ADM,"EL",SDT,0),"^",7)=+FHORN G KIL
|
---|
| 89 | F EL=SDT\1:0 S EL=$O(^FHPT(FHDFN,"A",ADM,"EL",EL)) Q:EL<1!(EL>EDT) D
|
---|
| 90 | .Q:$P(^FHPT(FHDFN,"A",ADM,"EL",EL,0),"^",7)
|
---|
| 91 | .Q:$P(^FHPT(FHDFN,"A",ADM,"EL",EL,0),"^",2)'=MEAL
|
---|
| 92 | .Q:$P(^FHPT(FHDFN,"A",ADM,"EL",EL,0),"^",3)'=TIM
|
---|
| 93 | .S X=EL D H^%DTC S:%Y=0 %Y=7 Q:%Y<0
|
---|
| 94 | .S WKDAYS=$E("MTWRFSX",%Y) Q:WKDAYS=""
|
---|
| 95 | .S:"MTWRFSX"[WKDAYS $P(^FHPT(FHDFN,"A",ADM,"EL",EL,0),"^",7)=+FHORN
|
---|
| 96 | .Q
|
---|
| 97 | KIL K %Y,DTE,EDT,EL,NUM,MEAL,MSG,FHORN,SDT,TIM,WKDAYS,WKD Q
|
---|