- FHORD41 ; HISC/REL/NCA - Isolation List ;4/27/93 08:07
- ;;5.5;DIETETICS;;Jan 28, 2005
- W @IOF,!!?19,"I S O L A T I O N / P R E C A U T I O N S",!!
- W ! K IOP,%ZIS S %ZIS("A")="Select LIST Printer: ",%ZIS="MQ" D ^%ZIS K %ZIS,IOP G:POP KIL
- I $D(IO("Q")) S FHPGM="F1^FHORD41",FHLST="" D EN2^FH G KIL
- U IO D F1 D ^%ZISC K %ZIS,IOP G KIL
- KIL K ^TMP($J) G KILL^XUSCLEAN
- F1 ; List Isolations
- D NOW^%DTC S NOW=%,DT=NOW\1 K ^TMP($J)
- F FHDFN=0:0 S FHDFN=$O(^FHPT("AIS",FHDFN)) Q:FHDFN<1 F ADM=0:0 S ADM=$O(^FHPT("AIS",FHDFN,ADM)) Q:ADM<1 D F2
- S PG=0 D HDR S WRDN=""
- F L1=0:0 S WRDN=$O(^TMP($J,WRDN)) Q:WRDN="" S RM="" F L2=0:0 S RM=$O(^TMP($J,WRDN,RM)) Q:RM="" F FHDFN=0:0 S FHDFN=$O(^TMP($J,WRDN,RM,FHDFN)) Q:FHDFN<1 S Y0=$G(^TMP($J,WRDN,RM,FHDFN)) D F3
- ;Add outpatient ISOLATION/PRECAUTIONS
- W !!,"O U T P A T I E N T S",!,"======================"
- W !!,"PATIENT",?34,"PLATE DELIVERY"
- F FHDFN=0:0 S FHDFN=$O(^FHPT("IP",FHDFN)) Q:FHDFN'>0 D
- .S FHIP=$P($G(^FHPT(FHDFN,0)),U,5) I FHIP="" Q
- .D PATNAME^FHOMUTL
- .S FHIPZN=$G(^FH(119.4,FHIP,0)),FHPC=$P(FHIPZN,U,2),FHDL=$P(FHIPZN,U,3)
- .W !!,FHPTNM,?34
- .W $S(FHPC="P":"Paper",1:"China")," ",$S(FHDL="N":"Nurse",1:"Food Svc")
- W ! Q
- F2 D PATNAME^FHOMUTL I DFN="" Q
- I '$D(^DPT(DFN,.1)) K ^FHPT("AIS",FHDFN,ADM) Q
- S X=$P($G(^FHPT(FHDFN,"A",ADM,0)),"^",8) I $G(^FHPT("AW",+X,FHDFN))'=ADM K ^FHPT("AIS",FHDFN,ADM) Q
- S WRDN=$P($G(^FH(119.6,+X,0)),"^",1),RM=$G(^DPT(DFN,.101)) S:RM="" RM=" "
- S PRE=$P($G(^FHPT(FHDFN,"A",ADM,0)),"^",10) Q:'PRE
- D CUR^FHORD7 S X=$P(X,"^",8) I X'="" S Y=Y_" ("_X_")"
- S ^TMP($J,WRDN,RM,FHDFN)=PRE_"^"_Y Q
- F3 D PATNAME^FHOMUTL I DFN="" Q
- S PRE=$P(Y0,"^",1),Y0=$P(Y0,"^",2),X0=^DPT(DFN,0),X1=$G(^FH(119.4,+PRE,0)),X2=$P(X1,"^",3),X1=$P(X1,"^",2) D PID^FHDPA D:$Y>57 HDR
- W !!,$E(WRDN,1,15),?17,$E(RM,1,10),?29,$E($P(X0,"^",1),1,23),?54,BID,?62,$S(X1="P":"Paper",1:"China")," ",$S(X2="N":" Nurse",1:"Food Svc")
- W:Y0'="" !?3,"Diet: ",Y0 Q
- HDR W:'($E(IOST,1,2)'="C-"&'PG) @IOF S PG=PG+1 W !?18,"I S O L A T I O N / P R E C A U T I O N S",?71,"Page ",PG
- S DTP=NOW D DTP^FH W !!?31,DTP
- W !!,"I N P A T I E N T S",!,"===================="
- W !!,"WARD",?17,"ROOM",?29,"PATIENT",?55,"ID#",?62,"PLATE DELIVERY" Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFHORD41 2230 printed Mar 13, 2025@20:58:08 Page 2
- FHORD41 ; HISC/REL/NCA - Isolation List ;4/27/93 08:07
- +1 ;;5.5;DIETETICS;;Jan 28, 2005
- +2 WRITE @IOF,!!?19,"I S O L A T I O N / P R E C A U T I O N S",!!
- +3 WRITE !
- KILL IOP,%ZIS
- SET %ZIS("A")="Select LIST Printer: "
- SET %ZIS="MQ"
- DO ^%ZIS
- KILL %ZIS,IOP
- if POP
- GOTO KIL
- +4 IF $DATA(IO("Q"))
- SET FHPGM="F1^FHORD41"
- SET FHLST=""
- DO EN2^FH
- GOTO KIL
- +5 USE IO
- DO F1
- DO ^%ZISC
- KILL %ZIS,IOP
- GOTO KIL
- KIL KILL ^TMP($JOB)
- GOTO KILL^XUSCLEAN
- F1 ; List Isolations
- +1 DO NOW^%DTC
- SET NOW=%
- SET DT=NOW\1
- KILL ^TMP($JOB)
- +2 FOR FHDFN=0:0
- SET FHDFN=$ORDER(^FHPT("AIS",FHDFN))
- if FHDFN<1
- QUIT
- FOR ADM=0:0
- SET ADM=$ORDER(^FHPT("AIS",FHDFN,ADM))
- if ADM<1
- QUIT
- DO F2
- +3 SET PG=0
- DO HDR
- SET WRDN=""
- +4 FOR L1=0:0
- SET WRDN=$ORDER(^TMP($JOB,WRDN))
- if WRDN=""
- QUIT
- SET RM=""
- FOR L2=0:0
- SET RM=$ORDER(^TMP($JOB,WRDN,RM))
- if RM=""
- QUIT
- FOR FHDFN=0:0
- SET FHDFN=$ORDER(^TMP($JOB,WRDN,RM,FHDFN))
- if FHDFN<1
- QUIT
- SET Y0=$GET(^TMP($JOB,WRDN,RM,FHDFN))
- DO F3
- +5 ;Add outpatient ISOLATION/PRECAUTIONS
- +6 WRITE !!,"O U T P A T I E N T S",!,"======================"
- +7 WRITE !!,"PATIENT",?34,"PLATE DELIVERY"
- +8 FOR FHDFN=0:0
- SET FHDFN=$ORDER(^FHPT("IP",FHDFN))
- if FHDFN'>0
- QUIT
- Begin DoDot:1
- +9 SET FHIP=$PIECE($GET(^FHPT(FHDFN,0)),U,5)
- IF FHIP=""
- QUIT
- +10 DO PATNAME^FHOMUTL
- +11 SET FHIPZN=$GET(^FH(119.4,FHIP,0))
- SET FHPC=$PIECE(FHIPZN,U,2)
- SET FHDL=$PIECE(FHIPZN,U,3)
- +12 WRITE !!,FHPTNM,?34
- +13 WRITE $SELECT(FHPC="P":"Paper",1:"China")," ",$SELECT(FHDL="N":"Nurse",1:"Food Svc")
- End DoDot:1
- +14 WRITE !
- QUIT
- F2 DO PATNAME^FHOMUTL
- IF DFN=""
- QUIT
- +1 IF '$DATA(^DPT(DFN,.1))
- KILL ^FHPT("AIS",FHDFN,ADM)
- QUIT
- +2 SET X=$PIECE($GET(^FHPT(FHDFN,"A",ADM,0)),"^",8)
- IF $GET(^FHPT("AW",+X,FHDFN))'=ADM
- KILL ^FHPT("AIS",FHDFN,ADM)
- QUIT
- +3 SET WRDN=$PIECE($GET(^FH(119.6,+X,0)),"^",1)
- SET RM=$GET(^DPT(DFN,.101))
- if RM=""
- SET RM=" "
- +4 SET PRE=$PIECE($GET(^FHPT(FHDFN,"A",ADM,0)),"^",10)
- if 'PRE
- QUIT
- +5 DO CUR^FHORD7
- SET X=$PIECE(X,"^",8)
- IF X'=""
- SET Y=Y_" ("_X_")"
- +6 SET ^TMP($JOB,WRDN,RM,FHDFN)=PRE_"^"_Y
- QUIT
- F3 DO PATNAME^FHOMUTL
- IF DFN=""
- QUIT
- +1 SET PRE=$PIECE(Y0,"^",1)
- SET Y0=$PIECE(Y0,"^",2)
- SET X0=^DPT(DFN,0)
- SET X1=$GET(^FH(119.4,+PRE,0))
- SET X2=$PIECE(X1,"^",3)
- SET X1=$PIECE(X1,"^",2)
- DO PID^FHDPA
- if $Y>57
- DO HDR
- +2 WRITE !!,$EXTRACT(WRDN,1,15),?17,$EXTRACT(RM,1,10),?29,$EXTRACT($PIECE(X0,"^",1),1,23),?54,BID,?62,$SELECT(X1="P":"Paper",1:"China")," ",$SELECT(X2="N":" Nurse",1:"Food Svc")
- +3 if Y0'=""
- WRITE !?3,"Diet: ",Y0
- QUIT
- HDR if '($EXTRACT(IOST,1,2)'="C-"&'PG)
- WRITE @IOF
- SET PG=PG+1
- WRITE !?18,"I S O L A T I O N / P R E C A U T I O N S",?71,"Page ",PG
- +1 SET DTP=NOW
- DO DTP^FH
- WRITE !!?31,DTP
- +2 WRITE !!,"I N P A T I E N T S",!,"===================="
- +3 WRITE !!,"WARD",?17,"ROOM",?29,"PATIENT",?55,"ID#",?62,"PLATE DELIVERY"
- QUIT
