FHORT11.m

FHORT11 ; HISC/REL/NCA - File Tubefeeding Order ;9/4/96  09:18

 ;;5.5;DIETETICS;;Jan 28, 2005

 L +^FHPT(FHDFN,"A",ADM,"TF",0) S:'$D(^FHPT(FHDFN,"A",ADM,"TF",0)) ^FHPT(FHDFN,"A",ADM,"TF",0)="^115.04^^"

 S TF=$P(^FHPT(FHDFN,"A",ADM,"TF",0),"^",3)+1,$P(^(0),"^",3,4)=TF_"^"_TF L -^FHPT(FHDFN,"A",ADM,"TF",0)

 D NOW^%DTC S NOW=%,DT=NOW\1

 S ^FHPT(FHDFN,"A",ADM,"TF",TF,0)=NOW_"^^^^"_TFCOM_"^"_TC_"^"_TK_"^^^"_DUZ

 S TF2=0 F P=0:0 S P=$O(TUN(P)) Q:P<1  D TF1

 S ^FHPT(FHDFN,"A",ADM,"TF",TF,"P",0)="^115.1P^"_TF2_"^"_TF2

 S $P(^FHPT(FHDFN,"A",ADM,0),"^",4)=TF,^FHPT("ADTF",FHDFN,ADM)="",EVT="T^O^"_TF D ^FHORX

 S:FHWF'=2 (FHORN,FHSAV)=""

 I CAN S FHOR="^^^^",FHLD="X",TYP="",D1=NOW,D2="",D4=0,COM="Hold Tray due to Tubefeeding" D STR^FHORD7 I $P(^FHPT(FHDFN,"A",ADM,0),"^",7) S CAN=CAN+1 D CAN^FHNO5 K NO

 D POST^FHORT3 W:FHWF'=2 "  ... filed" Q

TF1 S TF2=TF2+1,^FHPT(FHDFN,"A",ADM,"TF",TF,"P",TF2,0)=$P(TUN(P),"^",1,6)

 S ^FHPT(FHDFN,"A",ADM,"TF",TF,"P","B",+TUN(P),TF2)="" Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---FHORT11   985     printed  Apr 09, 2024@20:57:54                                                                                                                                                                                                      Page 2

FHORT11   ; HISC/REL/NCA - File Tubefeeding Order ;9/4/96  09:18

 +1       ;;5.5;DIETETICS;;Jan 28, 2005

 +2        LOCK +^FHPT(FHDFN,"A",ADM,"TF",0)

           if '$DATA(^FHPT(FHDFN,"A",ADM,"TF",0))

               SET ^FHPT(FHDFN,"A",ADM,"TF",0)="^115.04^^"

 +3        SET TF=$PIECE(^FHPT(FHDFN,"A",ADM,"TF",0),"^",3)+1

           SET $PIECE(^(0),"^",3,4)=TF_"^"_TF

           LOCK -^FHPT(FHDFN,"A",ADM,"TF",0)

 +4        DO NOW^%DTC

           SET NOW=%

           SET DT=NOW\1

 +5        SET ^FHPT(FHDFN,"A",ADM,"TF",TF,0)=NOW_"^^^^"_TFCOM_"^"_TC_"^"_TK_"^^^"_DUZ

 +6        SET TF2=0

           FOR P=0:0

               SET P=$ORDER(TUN(P))

               if P<1

                   QUIT 

               DO TF1

 +7        SET ^FHPT(FHDFN,"A",ADM,"TF",TF,"P",0)="^115.1P^"_TF2_"^"_TF2

 +8        SET $PIECE(^FHPT(FHDFN,"A",ADM,0),"^",4)=TF

           SET ^FHPT("ADTF",FHDFN,ADM)=""

           SET EVT="T^O^"_TF

           DO ^FHORX

 +9        if FHWF'=2

               SET (FHORN,FHSAV)=""

 +10       IF CAN

               SET FHOR="^^^^"

               SET FHLD="X"

               SET TYP=""

               SET D1=NOW

               SET D2=""

               SET D4=0

               SET COM="Hold Tray due to Tubefeeding"

               DO STR^FHORD7

               IF $PIECE(^FHPT(FHDFN,"A",ADM,0),"^",7)

                   SET CAN=CAN+1

                   DO CAN^FHNO5

                   KILL NO

 +11       DO POST^FHORT3

           if FHWF'=2

               WRITE "  ... filed"

           QUIT 

TF1        SET TF2=TF2+1

           SET ^FHPT(FHDFN,"A",ADM,"TF",TF,"P",TF2,0)=$PIECE(TUN(P),"^",1,6)

 +1        SET ^FHPT(FHDFN,"A",ADM,"TF",TF,"P","B",+TUN(P),TF2)=""

           QUIT