- FHWOR3 ; HISC/NCA - HL7 Early/Late Tray ;10/10/00 14:56
- ;;5.5;DIETETICS;;Jan 28, 2005
- S DATA=X
- N BAG,CODE,DATE,DAY,DTE,DP,EL,K,L1,LP,LSTWD,MEAL,PER,PIECE,SERV,SP,W1,WKD,WKDAYS,Y
- S:ITVL="" ITVL="ONCE"
- I 'SDT S TXT="No Start Date." D ERR^FHWOR Q
- S DATE=SDT D CVT^FHWOR S SDT=DATE\1
- I EDT S DATE=EDT D CVT^FHWOR S EDT=DATE\1
- I 'EDT S:ITVL="ONCE" EDT=SDT I 'EDT S TXT="No Stop Date." D ERR^FHWOR Q
- S SERV=$P(DATA,"|",2)
- I $P("EARLY",SERV,1)'="",$P("LATE",SERV,1)'="" S TXT="Wrong Type of Tray." D ERR^FHWOR Q
- 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
- I $E(PER,2)'=$E(SERV,1) S TXT="Wrong Service Period." D ERR^FHWOR Q
- S PIECE=$E(PER,3) I 'PIECE S TXT="No Time Specified." D ERR^FHWOR Q
- S K=$S(MEAL="B":0,MEAL="N":6,1:12)+($E(PER,2)="L"*3)
- S W1=$P($G(^FHPT(FHDFN,"A",ADM,0)),"^",8),DP=$P($G(^FH(119.6,+W1,0)),"^",8)
- K TM F L1=1:1:3 S TM(L1)=$P($G(^FH(119.73,+DP,1)),"^",K+L1)
- S TIM=TM(PIECE) I TIM="" F L1=1:1:3 S:TM(L1)'="" TIM=TM(L1)
- I TIM="" S TXT="No Early/Late Time on file." D ERR^FHWOR Q
- S BAG="N" I $P(X,"|",4)="bagged" S BAG="Y"
- S X=SDT_"@"_TIM,%DT="XT" D ^%DT S (SDT,FHDTIM)=Y,EDT=EDT+(SDT#1)
- S (FHV1,FHV2)="" D CUR^FHWOR31(FHDFN,ADM,FHDTIM,.FHV1,.FHV2)
- S (WKDAYS,WKD)=""
- I SDT=EDT D G:SP ERR G PROC
- .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
- .I SP S TXT="Early/Late Meal Already Ordered for this Date." Q
- .Q
- F LP=1:1 S CODE=$P(ITVL,"~",LP) Q:CODE="" D Q:TXT'=""
- .I CODE="ONCE" S TXT="ONCE is for one Day Only." Q
- .I $E(CODE,1)'="Q" S TXT="Wrong Interval specification. Use Only ONCE, QJ#, or Q1J#." Q
- .I +$E(CODE,2)>1 S TXT="Wrong interval specification. Use Only ONCE, QJ#, or Q1J#." Q
- .S LSTWD=$E(CODE,$L(CODE))
- .I LSTWD="J" S DAY=1 S WKD=WKD_$E("MTWRFSX",DAY) Q
- .I LSTWD?1N,$E(CODE,$L(CODE)-1)="J" D Q
- ..S DAY=LSTWD I DAY<1!(DAY>7) S TXT="Wrong Day Specification." Q
- ..S WKD=WKD_$E("MTWRFSX",DAY),WKDAYS=WKDAYS_DAY Q
- .S TXT="Wrong interval specification. Use Only ONCE, QJ#, or Q1J#."
- .Q
- I TXT'="" D ERR^FHWOR Q
- PROC ; Process Add E/L Trays
- D PROC^FHWOR31
- EXIT ; Exit Process Kill.
- 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
- ERR ; Send Error Message
- D ERR^FHWOR Q
- CAN ; Process Cancel/Discontinue from OE/RR
- D NOW^%DTC S NOW=%,CT=0
- D GADM^FHWORR
- 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
- S %=$S($D(^FHPT(FHDFN,"A",ADM,"EL",0)):$P(^(0),"^",4),1:0)-CT S:%'<0 $P(^(0),"^",4)=%
- K %,%H,%I,CT,EL D CSEND^FHWOR Q
- EL ; Code Early Late Tray
- K MSG S WKDAYS=""
- I SDT=EDT S ITVL="ONCE" G EL1
- 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
- EL1 S FILL="E"_";"_ADM_";;"_SDT_";"_EDT_";"_WKD_";"_MEAL_";"_TIM_";"_BAG
- D SET
- ; Code MSH, PID, and PV1
- D MSH^FHWOR
- ; code ORC
- S MSG(4)="ORC|SN||"_FILL_"^FH||||^"_ITVL_"^^"_SDT_"^"_EDT_"|||"_DUZ_"||"_DUZ_"|||"_NOW
- ; code ODT
- S MSG(5)="ODT|"_$S(SERV="E":"EARLY",1:"LATE")_"|^^^"_MEAL_SERV_NUM_"^^99FHS|"_$S(BAG="Y":"bagged",1:"")
- K FHWARD,FILL,HOSP,ITVL,FHORN,RM,SITE,WARD,WKDAYS,Z Q
- CODE ; Code Cancel/Discontinue Early Late Tray
- K MSG S ACT="OC",WKD="",CTR=0 D SITE^FH
- 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
- S STR=$G(^FHPT(FHDFN,"A",ADM,"EL",EDT,0))
- S FILL="E"_";"_ADM_";;"_SDT_";"_EDT_";"_WKD_";"_$P(STR,"^",2)_";"_$P(STR,"^",3)_";"_$P(STR,"^",4)
- ; code MSH
- S MSG(1)="MSH|^~\&|DIETETICS|"_SITE(1)_"|||||ORM"
- ; code PID
- S MSG(2)="PID|||"_DFN_"||"_$P($G(^DPT(DFN,0)),"^",1)
- ; code ORC
- S DATE=$$FMTHL7^XLFDT(NOW)
- S MSG(3)="ORC|"_ACT_"|"_FHORN_"^OR|"_FILL_"^FH|||||||||"_FHPV_"|||"_DATE_"|Dietetics Canceled Early/Late Tray order."
- K %,%Y,ACT,DATE,EDT,FILL,FHORN,SDT,SK,SITE,STR,WKD Q
- WKD ; Get week days
- D WKD^FHWOR31
- Q
- SET ; Set Date/Time in HL7 format
- D SET^FHWOR31
- Q
- NA ; OE/RR Number Assign
- S SDT=$P(FILL,";",4),EDT=$P(FILL,";",5),WKD=$P(FILL,";",6),MEAL=$P(FILL,";",7),TIM=$P(FILL,";",8),DTE=SDT
- G:'+FHORN KIL
- G:'$D(^FHPT(FHDFN,"A",ADM,"EL",SDT,0)) KIL
- I WKD="" S $P(^FHPT(FHDFN,"A",ADM,"EL",SDT,0),"^",7)=+FHORN G KIL
- F EL=SDT\1:0 S EL=$O(^FHPT(FHDFN,"A",ADM,"EL",EL)) Q:EL<1!(EL>EDT) D
- .Q:$P(^FHPT(FHDFN,"A",ADM,"EL",EL,0),"^",7)
- .Q:$P(^FHPT(FHDFN,"A",ADM,"EL",EL,0),"^",2)'=MEAL
- .Q:$P(^FHPT(FHDFN,"A",ADM,"EL",EL,0),"^",3)'=TIM
- .S X=EL D H^%DTC S:%Y=0 %Y=7 Q:%Y<0
- .S WKDAYS=$E("MTWRFSX",%Y) Q:WKDAYS=""
- .S:"MTWRFSX"[WKDAYS $P(^FHPT(FHDFN,"A",ADM,"EL",EL,0),"^",7)=+FHORN
- .Q
- KIL K %Y,DTE,EDT,EL,NUM,MEAL,MSG,FHORN,SDT,TIM,WKDAYS,WKD Q
- FHWOR3 ; HISC/NCA - HL7 Early/Late Tray ;10/10/00 14:56
- +1 ;;5.5;DIETETICS;;Jan 28, 2005
- +2 SET DATA=X
- +3 NEW BAG,CODE,DATE,DAY,DTE,DP,EL,K,L1,LP,LSTWD,MEAL,PER,PIECE,SERV,SP,W1,WKD,WKDAYS,Y
- +4 IF ITVL=""
- SET ITVL="ONCE"
- +5 IF 'SDT
- SET TXT="No Start Date."
- DO ERR^FHWOR
- QUIT
- +6 SET DATE=SDT
- DO CVT^FHWOR
- SET SDT=DATE\1
- +7 IF EDT
- SET DATE=EDT
- DO CVT^FHWOR
- SET EDT=DATE\1
- +8 IF 'EDT
- IF ITVL="ONCE"
- SET EDT=SDT
- IF 'EDT
- SET TXT="No Stop Date."
- DO ERR^FHWOR
- QUIT
- +9 SET SERV=$PIECE(DATA,"|",2)
- +10 IF $PIECE("EARLY",SERV,1)'=""
- IF $PIECE("LATE",SERV,1)'=""
- SET TXT="Wrong Type of Tray."
- DO ERR^FHWOR
- QUIT
- +11 SET PER=$PIECE(DATA,"|",3)
- SET PER=$EXTRACT(PER,4,$LENGTH(PER))
- SET MEAL=$EXTRACT(PER,1)
- IF "BNE"'[MEAL
- SET TXT="Wrong Service Period."
- DO ERR^FHWOR
- QUIT
- +12 IF $EXTRACT(PER,2)'=$EXTRACT(SERV,1)
- SET TXT="Wrong Service Period."
- DO ERR^FHWOR
- QUIT
- +13 SET PIECE=$EXTRACT(PER,3)
- IF 'PIECE
- SET TXT="No Time Specified."
- DO ERR^FHWOR
- QUIT
- +14 SET K=$SELECT(MEAL="B":0,MEAL="N":6,1:12)+($EXTRACT(PER,2)="L"*3)
- +15 SET W1=$PIECE($GET(^FHPT(FHDFN,"A",ADM,0)),"^",8)
- SET DP=$PIECE($GET(^FH(119.6,+W1,0)),"^",8)
- +16 KILL TM
- FOR L1=1:1:3
- SET TM(L1)=$PIECE($GET(^FH(119.73,+DP,1)),"^",K+L1)
- +17 SET TIM=TM(PIECE)
- IF TIM=""
- FOR L1=1:1:3
- IF TM(L1)'=""
- SET TIM=TM(L1)
- +18 IF TIM=""
- SET TXT="No Early/Late Time on file."
- DO ERR^FHWOR
- QUIT
- +19 SET BAG="N"
- IF $PIECE(X,"|",4)="bagged"
- SET BAG="Y"
- +20 SET X=SDT_"@"_TIM
- SET %DT="XT"
- DO ^%DT
- SET (SDT,FHDTIM)=Y
- SET EDT=EDT+(SDT#1)
- +21 SET (FHV1,FHV2)=""
- DO CUR^FHWOR31(FHDFN,ADM,FHDTIM,.FHV1,.FHV2)
- +22 SET (WKDAYS,WKD)=""
- +23 IF SDT=EDT
- Begin DoDot:1
- +24 SET SP=""
- FOR K=SDT\1:0
- SET K=$ORDER(^FHPT(FHDFN,"A",ADM,"EL",K))
- IF K<1!(K\1'=(SDT\1))
- QUIT
- IF $PIECE(^(K,0),"^",2)=MEAL
- SET SP=K
- QUIT
- +25 IF SP
- SET TXT="Early/Late Meal Already Ordered for this Date."
- QUIT
- +26 QUIT
- End DoDot:1
- IF SP
- GOTO ERR
- GOTO PROC
- +27 FOR LP=1:1
- SET CODE=$PIECE(ITVL,"~",LP)
- IF CODE=""
- QUIT
- Begin DoDot:1
- +28 IF CODE="ONCE"
- SET TXT="ONCE is for one Day Only."
- QUIT
- +29 IF $EXTRACT(CODE,1)'="Q"
- SET TXT="Wrong Interval specification. Use Only ONCE, QJ#, or Q1J#."
- QUIT
- +30 IF +$EXTRACT(CODE,2)>1
- SET TXT="Wrong interval specification. Use Only ONCE, QJ#, or Q1J#."
- QUIT
- +31 SET LSTWD=$EXTRACT(CODE,$LENGTH(CODE))
- +32 IF LSTWD="J"
- SET DAY=1
- SET WKD=WKD_$EXTRACT("MTWRFSX",DAY)
- QUIT
- +33 IF LSTWD?1N
- IF $EXTRACT(CODE,$LENGTH(CODE)-1)="J"
- Begin DoDot:2
- +34 SET DAY=LSTWD
- IF DAY<1!(DAY>7)
- SET TXT="Wrong Day Specification."
- QUIT
- +35 SET WKD=WKD_$EXTRACT("MTWRFSX",DAY)
- SET WKDAYS=WKDAYS_DAY
- QUIT
- End DoDot:2
- QUIT
- +36 SET TXT="Wrong interval specification. Use Only ONCE, QJ#, or Q1J#."
- +37 QUIT
- End DoDot:1
- IF TXT'=""
- QUIT
- +38 IF TXT'=""
- DO ERR^FHWOR
- QUIT
- PROC ; Process Add E/L Trays
- +1 DO PROC^FHWOR31
- EXIT ; Exit Process Kill.
- +1 KILL %,%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
- QUIT
- ERR ; Send Error Message
- +1 DO ERR^FHWOR
- QUIT
- CAN ; Process Cancel/Discontinue from OE/RR
- +1 DO NOW^%DTC
- SET NOW=%
- SET CT=0
- +2 DO GADM^FHWORR
- +3 FOR EL=%:0
- SET EL=$ORDER(^FHPT(FHDFN,"A",+ADM,"EL",EL))
- IF EL<1!(EL>$PIECE(FILL,";",5))
- QUIT
- SET X=$GET(^(EL,0))
- IF $PIECE(X,"^",7)=+FHORN
- KILL ^FHPT(FHDFN,"A",ADM,"EL",EL),^FHPT("ADLT",EL,FHDFN)
- SET CT=CT+1
- +4 SET %=$SELECT($DATA(^FHPT(FHDFN,"A",ADM,"EL",0)):$PIECE(^(0),"^",4),1:0)-CT
- IF %'<0
- SET $PIECE(^(0),"^",4)=%
- +5 KILL %,%H,%I,CT,EL
- DO CSEND^FHWOR
- QUIT
- EL ; Code Early Late Tray
- +1 KILL MSG
- SET WKDAYS=""
- +2 IF SDT=EDT
- SET ITVL="ONCE"
- GOTO EL1
- +3 SET ITVL=""
- FOR K=1:1
- SET Z=$EXTRACT(WKD,K)
- IF Z=""
- QUIT
- SET DAY=$FIND("MTWRFSX",Z)
- SET DAY=DAY-1
- IF ITVL'=""
- SET ITVL=ITVL_"~"
- SET ITVL=ITVL_"QJ"_DAY
- SET WKDAYS=WKDAYS_DAY
- EL1 SET FILL="E"_";"_ADM_";;"_SDT_";"_EDT_";"_WKD_";"_MEAL_";"_TIM_";"_BAG
- +1 DO SET
- +2 ; Code MSH, PID, and PV1
- +3 DO MSH^FHWOR
- +4 ; code ORC
- +5 SET MSG(4)="ORC|SN||"_FILL_"^FH||||^"_ITVL_"^^"_SDT_"^"_EDT_"|||"_DUZ_"||"_DUZ_"|||"_NOW
- +6 ; code ODT
- +7 SET MSG(5)="ODT|"_$SELECT(SERV="E":"EARLY",1:"LATE")_"|^^^"_MEAL_SERV_NUM_"^^99FHS|"_$SELECT(BAG="Y":"bagged",1:"")
- +8 KILL FHWARD,FILL,HOSP,ITVL,FHORN,RM,SITE,WARD,WKDAYS,Z
- QUIT
- CODE ; Code Cancel/Discontinue Early Late Tray
- +1 KILL MSG
- SET ACT="OC"
- SET WKD=""
- SET CTR=0
- DO SITE^FH
- +2 SET EDT=""
- FOR SK=0:0
- SET SK=$ORDER(NN(FHORN,SK))
- IF SK<1
- QUIT
- SET CTR=CTR+1
- IF CTR=1
- SET SDT=SK
- SET EDT=SK
- DO WKD
- +3 SET STR=$GET(^FHPT(FHDFN,"A",ADM,"EL",EDT,0))
- +4 SET FILL="E"_";"_ADM_";;"_SDT_";"_EDT_";"_WKD_";"_$PIECE(STR,"^",2)_";"_$PIECE(STR,"^",3)_";"_$PIECE(STR,"^",4)
- +5 ; code MSH
- +6 SET MSG(1)="MSH|^~\&|DIETETICS|"_SITE(1)_"|||||ORM"
- +7 ; code PID
- +8 SET MSG(2)="PID|||"_DFN_"||"_$PIECE($GET(^DPT(DFN,0)),"^",1)
- +9 ; code ORC
- +10 SET DATE=$$FMTHL7^XLFDT(NOW)
- +11 SET MSG(3)="ORC|"_ACT_"|"_FHORN_"^OR|"_FILL_"^FH|||||||||"_FHPV_"|||"_DATE_"|Dietetics Canceled Early/Late Tray order."
- +12 KILL %,%Y,ACT,DATE,EDT,FILL,FHORN,SDT,SK,SITE,STR,WKD
- QUIT
- WKD ; Get week days
- +1 DO WKD^FHWOR31
- +2 QUIT
- SET ; Set Date/Time in HL7 format
- +1 DO SET^FHWOR31
- +2 QUIT
- NA ; OE/RR Number Assign
- +1 SET SDT=$PIECE(FILL,";",4)
- SET EDT=$PIECE(FILL,";",5)
- SET WKD=$PIECE(FILL,";",6)
- SET MEAL=$PIECE(FILL,";",7)
- SET TIM=$PIECE(FILL,";",8)
- SET DTE=SDT
- +2 IF '+FHORN
- GOTO KIL
- +3 IF '$DATA(^FHPT(FHDFN,"A",ADM,"EL",SDT,0))
- GOTO KIL
- +4 IF WKD=""
- SET $PIECE(^FHPT(FHDFN,"A",ADM,"EL",SDT,0),"^",7)=+FHORN
- GOTO KIL
- +5 FOR EL=SDT\1:0
- SET EL=$ORDER(^FHPT(FHDFN,"A",ADM,"EL",EL))
- IF EL<1!(EL>EDT)
- QUIT
- Begin DoDot:1
- +6 IF $PIECE(^FHPT(FHDFN,"A",ADM,"EL",EL,0),"^",7)
- QUIT
- +7 IF $PIECE(^FHPT(FHDFN,"A",ADM,"EL",EL,0),"^",2)'=MEAL
- QUIT
- +8 IF $PIECE(^FHPT(FHDFN,"A",ADM,"EL",EL,0),"^",3)'=TIM
- QUIT
- +9 SET X=EL
- DO H^%DTC
- IF %Y=0
- SET %Y=7
- IF %Y<0
- QUIT
- +10 SET WKDAYS=$EXTRACT("MTWRFSX",%Y)
- IF WKDAYS=""
- QUIT
- +11 IF "MTWRFSX"[WKDAYS
- SET $PIECE(^FHPT(FHDFN,"A",ADM,"EL",EL,0),"^",7)=+FHORN
- +12 QUIT
- End DoDot:1
- KIL KILL %Y,DTE,EDT,EL,NUM,MEAL,MSG,FHORN,SDT,TIM,WKDAYS,WKD
- QUIT
