FHORE21 ; HISC/REL/NCA - List Early/Late Trays (cont) ;11/9/94 13:33
;;5.5;DIETETICS;**5,8,15**;Jan 28, 2005;Build 2
;patch #5 - added outpt room-bed.
S D1=DTE,COUNT=0,LINE=1 K ^TMP($J) S ANS=""
F2 S D1=$O(^FHPT("ADLT",D1)) G:D1<1!(D1\1'=DTE) P0 S FHDFN=0
F3 S FHDFN=$O(^FHPT("ADLT",D1,FHDFN)) G:FHDFN<1 F2 S ADM=0
F4 S ADM=$O(^FHPT("ADLT",D1,FHDFN,ADM)) G:ADM<1 F3
I $S($D(^DGPM(ADM,0)):$P(^(0),"^",17),1:1) G F7
S Y(0)=$G(^FHPT(FHDFN,"A",ADM,"EL",D1,0)) G:Y(0)="" F7
S X=$G(^FHPT(FHDFN,"A",ADM,0)),OLW=$P(X,"^",11),IS=$P(X,"^",10)
S W1=$P(X,"^",8),X2=$G(^FH(119.6,+W1,0)),WARD=$P(X2,"^",1)
G:WARD="" F4 S P0=$P(X2,"^",8) I FHP,P0'=FHP G F4
S M1=$P(Y(0),"^",2) I MEAL'="A",M1'=MEAL G F4
D CUR G:FHLD'="" F4 S O1=Y
S ^TMP($J,"EL",D1_"-"_$P(Y(0),"^",6),FHDFN_"-"_ADM)=WARD_"^"_P0_"^"_OLW_"^"_IS_"^"_O1_"^"_$P(Y(0),"^",2,4) G F4
P0 D NOW^%DTC S DTP=% D DTP^FH S H1=DTP,DTP=DTE\1 D DTP^FH S L1=DTP
I LAB S LAB=$P($G(^FH(119.9,1,"D",IOS,0)),"^",2) S:'LAB LAB=1
S S1=LAB=2*5+36
P1 S M2="Z",PG=0 D:'LAB HDR
S N1="" F S N1=$O(^TMP($J,"EL",N1)) Q:N1=""!(ANS="^") S N2="" F S N2=$O(^TMP($J,"EL",N1,N2)) Q:N2="" S Y=^(N2) D P2 Q:ANS="^"
;
D ^FHOMELT ;List Outpatient (Recurring Meals) Late Trays
I LAB<1 W !!
S FHPREV="" D:'LAB OPHDR
F N1="B","N","E" D
.I '$D(^TMP($J,N1)) Q
.S N2="" F S N2=$O(^TMP($J,N1,N2)) Q:N2=""!(ANS="^") D
..S FHDATA=$G(^TMP($J,N1,N2)),FHLOC=$P(FHDATA,U,1),FHDFN=$P(FHDATA,U,2)
..S FHBAG=$P(FHDATA,U,3),(O1,FHDIET)=$P(FHDATA,U,4),RM=$P(FHDATA,U,5) D PATNAME^FHOMUTL
..S (WARD,FHLOCNM)=$E($P($G(^FH(119.6,FHLOC,0)),U,1),1,10)
..S FHIP=$P($G(^FHPT(FHDFN,0)),U,5),FHIPD="",IS=""
..I FHIP'="" S (IS,FHIPD)=$P($G(^FH(119.4,FHIP,0)),U,2)_$P($G(^FH(119.4,FHIP,0)),U,3)
..S P1=FHPTNM,BID=FHBID,TIM=$P(N2,"~",1),M1=N1
..I LAB<1 D OUTP
..I LAB>0,LAB<3 D P3
..I LAB>2 D LL Q
I LAB>2 D DPLL^FHLABEL K ^TMP($J) Q
I LAB<3 F K=1:1:$S('LAB:1,1:18) W !
Q
P2 S FHDFN=+N2,WARD=$P(Y,"^",1),P0=$P(Y,"^",2),OLW=$P(Y,"^",3),IS=$P(Y,"^",4),O1=$P(Y,"^",5),M1=$P(Y,"^",6),TIM=$P(Y,"^",7),BAG=$P(Y,"^",8)
I IS S IS=^FH(119.4,IS,0),IS=$P(IS,"^",2)_$P(IS,"^",3)
D PATNAME^FHOMUTL I DFN="" Q
S Y=^DPT(DFN,0),P1=$P(Y,"^",1) D PID^FHDPA
S RM=$G(^DPT(DFN,.101)) I LAB>2 D LL Q
G:LAB P3
I $Y>(IOSL-10) D HDR Q:ANS="^" W !!?56,$S(M1="B":"Breakfast ",M1="N":" Noon ",1:" Evening "),$J(TIM,6),! S M2=M1_TIM
S X=M1_TIM I X'=M2 W !!?56,$S(M1="B":"Breakfast ",M1="N":" Noon ",1:" Evening "),$J(TIM,6),! S M2=X
W !,$S(WARD'="":$E(WARD,1,10),1:"")_$S(RM'="":"/"_$E(RM,1,10),1:""),?24,$E(P1,1,22),?50,BID,?61,$S(IS'="":IS,1:""),?67,$S(BAG="Y":"YES",1:""),?73,O1
D ALG^FHCLN W !,"Allergies: ",$S(ALG="":"None on file",1:ALG)
Q
P3 S P1=$E(P1,1,22),WARD=$E(WARD,1,15),RM=$E(RM,1,10)
D ALG^FHCLN
W !,$S(M1="B":"Breakfast",M1="N":" Noon ",1:" Evening"),?10,TIM,?(S1-12),L1 W:LAB=2 !
W !,$E(P1,1,S1-5-$L(WARD)),?(S1-3-$L(WARD)),WARD
W !,BID W:IS'="" ?(S1-3\2),IS W ?(S1-3-$L(RM)),RM W:LAB=2 !
I $L(O1)<S1 W !,O1,$S(ALG="":"",1:" *ALG"),!!
E S L=$S($L($P(O1,",",1,3))<S1:3,1:2) W !,$P(O1,",",1,L),!,$E($P(O1,",",L+1,5),2,99),$S(ALG="":"",1:"*ALG"),!
W:LAB=2 ! Q
OUTP ;
I $Y>(IOSL-10) D OPHDR Q:ANS="^"
S NEW=N1_$P(N2,"~",1) I FHPREV'=NEW W !!?56,$S(N1="B":"Breakfast ",N1="N":" Noon ",1:" Evening "),$J($P(N2,"~",1),6),!
W !,FHLOCNM
D PATNAME^FHOMUTL W "/"_RM,?24,FHPTNM,?50,FHBID
W ?61,FHIPD,?67,$S(FHBAG="Y":"YES",1:"")
W ?73,FHDIET
D ALG^FHCLN W !,"Allergies: ",$S(ALG="":"None on file",1:ALG)
S FHPREV=N1_$P(N2,"~",1)
Q
F7 K ^FHPT("ADLT",D1,FHDFN,ADM) G F4
CUR S A1=0,(Y,FHLD,FHOR)="" F KK=0:0 S KK=$O(^FHPT(FHDFN,"A",ADM,"AC",KK)) Q:KK<1!(KK>D1) S A1=KK
Q:'A1 S FHORD=$P(^FHPT(FHDFN,"A",ADM,"AC",A1,0),"^",2),X=^FHPT(FHDFN,"A",ADM,"DI",FHORD,0),FHOR=$P(X,"^",2,6),FHLD=$P(X,"^",7)
I FHLD'="" S FHDU=";"_$P(^DD(115.02,6,0),"^",3),%=$F(FHDU,";"_FHLD_":") Q:%<1 S Y=$P($E(FHDU,%,999),";",1) Q
S Y="" F A1=1:1:5 S D3=$P(FHOR,"^",A1) I D3 S:Y'="" Y=Y_", " S Y=Y_$P(^FH(111,D3,0),"^",7)
Q
DP K N S Y=$G(^FH(119.73,+P0,1))
F KK=1,2,3,7,8,9,13,14,15 S X=$P(Y,"^",KK) I X'="" S N($S(KK<7:"B",KK<13:"N",1:"E"),X)=""
Q
HDR ; Print Header (INPATIENT)
I PG,IOST?1"C-".E R !!,"Press RETURN to continue or ""^"" to exit. ",ANS:DTIME S:'$T!(ANS["^") ANS="^" Q:ANS="^" I "^"'[ANS W !,"Enter Return or ""^""." G HDR
W:'($E(IOST,1,2)'="C-"&'PG) @IOF S PG=PG+1
W !?32,"I N P A T I E N T E A R L Y / L A T E T R A Y S",?110,H1
W !,$S('FHP:"Consolidated",1:$P(^FH(119.73,FHP,0),"^",1)),?61,L1,?121,"Page ",PG
W !!,"Ward/Room",?24,"Patient",?50,"ID#",?61,"Iso Bag Current-Diet",! Q
OPHDR ; Print Header (OUTPATIENT)
I PG,IOST?1"C-".E R !!,"Press RETURN to continue or ""^"" to exit. ",ANS:DTIME S:'$T!(ANS["^") ANS="^" Q:ANS="^" I "^"'[ANS W !,"Enter Return or ""^""." G OPHDR
W:$E(IOST,1,2)="C-" @IOF S PG=PG+1
W !?32,"O U T P A T I E N T E A R L Y / L A T E T R A Y S",?110,H1
W !,$S('FHP:"Consolidated",1:$P(^FH(119.73,FHP,0),"^",1)),?61,L1,?121,"Page ",PG
W !!,"Ward/Room",?24,"Patient",?50,"ID#",?61,"Iso Bag Current-Diet",! Q
LL ;
D ALG^FHCLN
S FHCOL=$S(LAB=3:3,1:2)
I LABSTART>1 F FHLABST=1:1:(LABSTART-1)*FHCOL D S LABSTART=1
.I LAB=3 S (PCL1,PCL2,PCL3,PCL4,PCL5,PCL6)="" D LL3^FHLABEL
.I LAB=4 S (PCL1,PCL2,PCL3,PCL4,PCL5,PCL6,PCL7,PCL8)="" D LL4^FHLABEL
.Q
S SL1=$S(LAB=3:25,1:38)
S MEALTM=$S(M1="B":"Breakfast",M1="N":"Noon",1:"Evening")_" "_TIM
S BID=BID_$S(ALG="":"",1:" *ALG")
S BIDIS=BID_$E(" ",1,12-$L(BID))_IS
S WARD=$E(WARD,1,15),WLN=$L(WARD),RM=$E(RM,1,10)
I LAB=3 D
.S P1=$E(P1,1,24-WLN)
.S (PCL1,PCL6)="",PCL2=MEALTM_$J(L1,25-$L(MEALTM))
.S PCL3=P1_$J(WARD,25-$L(P1)),PCL4=BIDIS_$J(RM,25-$L(BIDIS))
.S PCL5=$E(O1,1,29) D LL3^FHLABEL
I LAB=4 D
.S P1=$E(P1,1,37-WLN)
.S (PCL1,PCL2,PCL7,PCL8)="",PCL3=MEALTM_$J(L1,38-$L(MEALTM))
.S PCL4=P1_$J(WARD,38-$L(P1)),PCL5=BIDIS_$J(RM,38-$L(BIDIS))
.S PCL6=$E(O1,1,42) D LL4^FHLABEL
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFHORE21 5948 printed Apr 09, 2024@20:52:26 Page 2
FHORE21 ; HISC/REL/NCA - List Early/Late Trays (cont) ;11/9/94 13:33
+1 ;;5.5;DIETETICS;**5,8,15**;Jan 28, 2005;Build 2
+2 ;patch #5 - added outpt room-bed.
+3 SET D1=DTE
SET COUNT=0
SET LINE=1
KILL ^TMP($JOB)
SET ANS=""
F2 SET D1=$ORDER(^FHPT("ADLT",D1))
if D1<1!(D1\1'=DTE)
GOTO P0
SET FHDFN=0
F3 SET FHDFN=$ORDER(^FHPT("ADLT",D1,FHDFN))
if FHDFN<1
GOTO F2
SET ADM=0
F4 SET ADM=$ORDER(^FHPT("ADLT",D1,FHDFN,ADM))
if ADM<1
GOTO F3
+1 IF $SELECT($DATA(^DGPM(ADM,0)):$PIECE(^(0),"^",17),1:1)
GOTO F7
+2 SET Y(0)=$GET(^FHPT(FHDFN,"A",ADM,"EL",D1,0))
if Y(0)=""
GOTO F7
+3 SET X=$GET(^FHPT(FHDFN,"A",ADM,0))
SET OLW=$PIECE(X,"^",11)
SET IS=$PIECE(X,"^",10)
+4 SET W1=$PIECE(X,"^",8)
SET X2=$GET(^FH(119.6,+W1,0))
SET WARD=$PIECE(X2,"^",1)
+5 if WARD=""
GOTO F4
SET P0=$PIECE(X2,"^",8)
IF FHP
IF P0'=FHP
GOTO F4
+6 SET M1=$PIECE(Y(0),"^",2)
IF MEAL'="A"
IF M1'=MEAL
GOTO F4
+7 DO CUR
if FHLD'=""
GOTO F4
SET O1=Y
+8 SET ^TMP($JOB,"EL",D1_"-"_$PIECE(Y(0),"^",6),FHDFN_"-"_ADM)=WARD_"^"_P0_"^"_OLW_"^"_IS_"^"_O1_"^"_$PIECE(Y(0),"^",2,4)
GOTO F4
P0 DO NOW^%DTC
SET DTP=%
DO DTP^FH
SET H1=DTP
SET DTP=DTE\1
DO DTP^FH
SET L1=DTP
+1 IF LAB
SET LAB=$PIECE($GET(^FH(119.9,1,"D",IOS,0)),"^",2)
if 'LAB
SET LAB=1
+2 SET S1=LAB=2*5+36
P1 SET M2="Z"
SET PG=0
if 'LAB
DO HDR
+1 SET N1=""
FOR
SET N1=$ORDER(^TMP($JOB,"EL",N1))
if N1=""!(ANS="^")
QUIT
SET N2=""
FOR
SET N2=$ORDER(^TMP($JOB,"EL",N1,N2))
if N2=""
QUIT
SET Y=^(N2)
DO P2
if ANS="^"
QUIT
+2 ;
+3 ;List Outpatient (Recurring Meals) Late Trays
DO ^FHOMELT
+4 IF LAB<1
WRITE !!
+5 SET FHPREV=""
if 'LAB
DO OPHDR
+6 FOR N1="B","N","E"
Begin DoDot:1
+7 IF '$DATA(^TMP($JOB,N1))
QUIT
+8 SET N2=""
FOR
SET N2=$ORDER(^TMP($JOB,N1,N2))
if N2=""!(ANS="^")
QUIT
Begin DoDot:2
+9 SET FHDATA=$GET(^TMP($JOB,N1,N2))
SET FHLOC=$PIECE(FHDATA,U,1)
SET FHDFN=$PIECE(FHDATA,U,2)
+10 SET FHBAG=$PIECE(FHDATA,U,3)
SET (O1,FHDIET)=$PIECE(FHDATA,U,4)
SET RM=$PIECE(FHDATA,U,5)
DO PATNAME^FHOMUTL
+11 SET (WARD,FHLOCNM)=$EXTRACT($PIECE($GET(^FH(119.6,FHLOC,0)),U,1),1,10)
+12 SET FHIP=$PIECE($GET(^FHPT(FHDFN,0)),U,5)
SET FHIPD=""
SET IS=""
+13 IF FHIP'=""
SET (IS,FHIPD)=$PIECE($GET(^FH(119.4,FHIP,0)),U,2)_$PIECE($GET(^FH(119.4,FHIP,0)),U,3)
+14 SET P1=FHPTNM
SET BID=FHBID
SET TIM=$PIECE(N2,"~",1)
SET M1=N1
+15 IF LAB<1
DO OUTP
+16 IF LAB>0
IF LAB<3
DO P3
+17 IF LAB>2
DO LL
QUIT
End DoDot:2
End DoDot:1
+18 IF LAB>2
DO DPLL^FHLABEL
KILL ^TMP($JOB)
QUIT
+19 IF LAB<3
FOR K=1:1:$SELECT('LAB:1,1:18)
WRITE !
+20 QUIT
P2 SET FHDFN=+N2
SET WARD=$PIECE(Y,"^",1)
SET P0=$PIECE(Y,"^",2)
SET OLW=$PIECE(Y,"^",3)
SET IS=$PIECE(Y,"^",4)
SET O1=$PIECE(Y,"^",5)
SET M1=$PIECE(Y,"^",6)
SET TIM=$PIECE(Y,"^",7)
SET BAG=$PIECE(Y,"^",8)
+1 IF IS
SET IS=^FH(119.4,IS,0)
SET IS=$PIECE(IS,"^",2)_$PIECE(IS,"^",3)
+2 DO PATNAME^FHOMUTL
IF DFN=""
QUIT
+3 SET Y=^DPT(DFN,0)
SET P1=$PIECE(Y,"^",1)
DO PID^FHDPA
+4 SET RM=$GET(^DPT(DFN,.101))
IF LAB>2
DO LL
QUIT
+5 if LAB
GOTO P3
+6 IF $Y>(IOSL-10)
DO HDR
if ANS="^"
QUIT
WRITE !!?56,$SELECT(M1="B":"Breakfast ",M1="N":" Noon ",1:" Evening "),$JUSTIFY(TIM,6),!
SET M2=M1_TIM
+7 SET X=M1_TIM
IF X'=M2
WRITE !!?56,$SELECT(M1="B":"Breakfast ",M1="N":" Noon ",1:" Evening "),$JUSTIFY(TIM,6),!
SET M2=X
+8 WRITE !,$SELECT(WARD'="":$EXTRACT(WARD,1,10),1:"")_$SELECT(RM'="":"/"_$EXTRACT(RM,1,10),1:""),?24,$EXTRACT(P1,1,22),?50,BID,?61,$SELECT(IS'="":IS,1:""),?67,$SELECT(BAG="Y":"YES",1:""),?73,O1
+9 DO ALG^FHCLN
WRITE !,"Allergies: ",$SELECT(ALG="":"None on file",1:ALG)
+10 QUIT
P3 SET P1=$EXTRACT(P1,1,22)
SET WARD=$EXTRACT(WARD,1,15)
SET RM=$EXTRACT(RM,1,10)
+1 DO ALG^FHCLN
+2 WRITE !,$SELECT(M1="B":"Breakfast",M1="N":" Noon ",1:" Evening"),?10,TIM,?(S1-12),L1
if LAB=2
WRITE !
+3 WRITE !,$EXTRACT(P1,1,S1-5-$LENGTH(WARD)),?(S1-3-$LENGTH(WARD)),WARD
+4 WRITE !,BID
if IS'=""
WRITE ?(S1-3\2),IS
WRITE ?(S1-3-$LENGTH(RM)),RM
if LAB=2
WRITE !
+5 IF $LENGTH(O1)<S1
WRITE !,O1,$SELECT(ALG="":"",1:" *ALG"),!!
+6 IF '$TEST
SET L=$SELECT($LENGTH($PIECE(O1,",",1,3))<S1:3,1:2)
WRITE !,$PIECE(O1,",",1,L),!,$EXTRACT($PIECE(O1,",",L+1,5),2,99),$SELECT(ALG="":"",1:"*ALG"),!
+7 if LAB=2
WRITE !
QUIT
OUTP ;
+1 IF $Y>(IOSL-10)
DO OPHDR
if ANS="^"
QUIT
+2 SET NEW=N1_$PIECE(N2,"~",1)
IF FHPREV'=NEW
WRITE !!?56,$SELECT(N1="B":"Breakfast ",N1="N":" Noon ",1:" Evening "),$JUSTIFY($PIECE(N2,"~",1),6),!
+3 WRITE !,FHLOCNM
+4 DO PATNAME^FHOMUTL
WRITE "/"_RM,?24,FHPTNM,?50,FHBID
+5 WRITE ?61,FHIPD,?67,$SELECT(FHBAG="Y":"YES",1:"")
+6 WRITE ?73,FHDIET
+7 DO ALG^FHCLN
WRITE !,"Allergies: ",$SELECT(ALG="":"None on file",1:ALG)
+8 SET FHPREV=N1_$PIECE(N2,"~",1)
+9 QUIT
F7 KILL ^FHPT("ADLT",D1,FHDFN,ADM)
GOTO F4
CUR SET A1=0
SET (Y,FHLD,FHOR)=""
FOR KK=0:0
SET KK=$ORDER(^FHPT(FHDFN,"A",ADM,"AC",KK))
if KK<1!(KK>D1)
QUIT
SET A1=KK
+1 if 'A1
QUIT
SET FHORD=$PIECE(^FHPT(FHDFN,"A",ADM,"AC",A1,0),"^",2)
SET X=^FHPT(FHDFN,"A",ADM,"DI",FHORD,0)
SET FHOR=$PIECE(X,"^",2,6)
SET FHLD=$PIECE(X,"^",7)
+2 IF FHLD'=""
SET FHDU=";"_$PIECE(^DD(115.02,6,0),"^",3)
SET %=$FIND(FHDU,";"_FHLD_":")
if %<1
QUIT
SET Y=$PIECE($EXTRACT(FHDU,%,999),";",1)
QUIT
+3 SET Y=""
FOR A1=1:1:5
SET D3=$PIECE(FHOR,"^",A1)
IF D3
if Y'=""
SET Y=Y_", "
SET Y=Y_$PIECE(^FH(111,D3,0),"^",7)
+4 QUIT
DP KILL N
SET Y=$GET(^FH(119.73,+P0,1))
+1 FOR KK=1,2,3,7,8,9,13,14,15
SET X=$PIECE(Y,"^",KK)
IF X'=""
SET N($SELECT(KK<7:"B",KK<13:"N",1:"E"),X)=""
+2 QUIT
HDR ; Print Header (INPATIENT)
+1 IF PG
IF IOST?1"C-".E
READ !!,"Press RETURN to continue or ""^"" to exit. ",ANS:DTIME
if '$TEST!(ANS["^")
SET ANS="^"
if ANS="^"
QUIT
IF "^"'[ANS
WRITE !,"Enter Return or ""^""."
GOTO HDR
+2 if '($EXTRACT(IOST,1,2)'="C-"&'PG)
WRITE @IOF
SET PG=PG+1
+3 WRITE !?32,"I N P A T I E N T E A R L Y / L A T E T R A Y S",?110,H1
+4 WRITE !,$SELECT('FHP:"Consolidated",1:$PIECE(^FH(119.73,FHP,0),"^",1)),?61,L1,?121,"Page ",PG
+5 WRITE !!,"Ward/Room",?24,"Patient",?50,"ID#",?61,"Iso Bag Current-Diet",!
QUIT
OPHDR ; Print Header (OUTPATIENT)
+1 IF PG
IF IOST?1"C-".E
READ !!,"Press RETURN to continue or ""^"" to exit. ",ANS:DTIME
if '$TEST!(ANS["^")
SET ANS="^"
if ANS="^"
QUIT
IF "^"'[ANS
WRITE !,"Enter Return or ""^""."
GOTO OPHDR
+2 if $EXTRACT(IOST,1,2)="C-"
WRITE @IOF
SET PG=PG+1
+3 WRITE !?32,"O U T P A T I E N T E A R L Y / L A T E T R A Y S",?110,H1
+4 WRITE !,$SELECT('FHP:"Consolidated",1:$PIECE(^FH(119.73,FHP,0),"^",1)),?61,L1,?121,"Page ",PG
+5 WRITE !!,"Ward/Room",?24,"Patient",?50,"ID#",?61,"Iso Bag Current-Diet",!
QUIT
LL ;
+1 DO ALG^FHCLN
+2 SET FHCOL=$SELECT(LAB=3:3,1:2)
+3 IF LABSTART>1
FOR FHLABST=1:1:(LABSTART-1)*FHCOL
Begin DoDot:1
+4 IF LAB=3
SET (PCL1,PCL2,PCL3,PCL4,PCL5,PCL6)=""
DO LL3^FHLABEL
+5 IF LAB=4
SET (PCL1,PCL2,PCL3,PCL4,PCL5,PCL6,PCL7,PCL8)=""
DO LL4^FHLABEL
+6 QUIT
End DoDot:1
SET LABSTART=1
+7 SET SL1=$SELECT(LAB=3:25,1:38)
+8 SET MEALTM=$SELECT(M1="B":"Breakfast",M1="N":"Noon",1:"Evening")_" "_TIM
+9 SET BID=BID_$SELECT(ALG="":"",1:" *ALG")
+10 SET BIDIS=BID_$EXTRACT(" ",1,12-$LENGTH(BID))_IS
+11 SET WARD=$EXTRACT(WARD,1,15)
SET WLN=$LENGTH(WARD)
SET RM=$EXTRACT(RM,1,10)
+12 IF LAB=3
Begin DoDot:1
+13 SET P1=$EXTRACT(P1,1,24-WLN)
+14 SET (PCL1,PCL6)=""
SET PCL2=MEALTM_$JUSTIFY(L1,25-$LENGTH(MEALTM))
+15 SET PCL3=P1_$JUSTIFY(WARD,25-$LENGTH(P1))
SET PCL4=BIDIS_$JUSTIFY(RM,25-$LENGTH(BIDIS))
+16 SET PCL5=$EXTRACT(O1,1,29)
DO LL3^FHLABEL
End DoDot:1
+17 IF LAB=4
Begin DoDot:1
+18 SET P1=$EXTRACT(P1,1,37-WLN)
+19 SET (PCL1,PCL2,PCL7,PCL8)=""
SET PCL3=MEALTM_$JUSTIFY(L1,38-$LENGTH(MEALTM))
+20 SET PCL4=P1_$JUSTIFY(WARD,38-$LENGTH(P1))
SET PCL5=BIDIS_$JUSTIFY(RM,38-$LENGTH(BIDIS))
+21 SET PCL6=$EXTRACT(O1,1,42)
DO LL4^FHLABEL
End DoDot:1
+22 QUIT
