FHXWRD.m

FHXWRD ; HISC/REL/NCA - Update Patient Dietetic Ward ;8/7/95  15:13

 ;;5.5;DIETETICS;;Jan 28, 2005

EN1 ; Ask user whether they want to update

 R !!,"Update the Patient Dietetic Location? N// ",X:DTIME G:'$T!(X["^") KIL S:X="" X="N" D TR^FH

 I $P("YES",X,1)'="",$P("NO",X,1)'="" D MSG G EN1

 I X?1"Y".E D E1 W !!,"....Done"

 G KIL

E1 ; Process Updating Patient Dietetic Ward

 K ^FHPT("AW")

 S NX="" F  S NX=$O(^DPT("CN",NX)) Q:NX=""  F DFN=0:0 S DFN=$O(^DPT("CN",NX,DFN)) Q:DFN'>0  S ADM=^(DFN) D SET

 Q

SET D DID^FHDPA

 S FHZ115="P"_DFN D CHECK^FHOMDPA I FHDFN="" Q

 Q:$D(^FHPT(FHDFN,"A",+ADM,0))#2=0

 S Y=$P(^FHPT(FHDFN,"A",ADM,0),"^",8,9),$P(^(0),"^",8,9)=FHWRD_"^"_FHRMB

 S:FHWRD ^FHPT("AW",FHWRD,FHDFN)=ADM

 I (FHWRD_"^"_FHRMB)'=Y S EVT="L^T^^"_$P(Y,"^",1)_"~"_$P(Y,"^",2) S:FHWRD EVT=EVT_"~"_FHWRD_"~"_FHRMB S:'FHWRD $P(EVT,"^",2)="D" D ^FHORX

 Q:'FHWRD

 ; Update Type of Service

 S FHX3=$P($G(^FH(119.6,+FHWRD,0)),"^",10) S:FHX3="" FHX3="TCD" I FHX3[$P(^FHPT(FHDFN,"A",ADM,0),"^",5) Q

 S FHX3=$S($L(FHX3)=1:FHX3,FHX3["D":"D",1:"C"),$P(^FHPT(FHDFN,"A",ADM,0),"^",5)=FHX3

 S FHX2=$P(^FHPT(FHDFN,"A",ADM,0),"^",2) I FHX2,$P($G(^FHPT(FHDFN,"A",ADM,"DI",+FHX2,0)),"^",8)'="" S $P(^(0),"^",8)=FHX3

 Q

KIL G KILL^XUSCLEAN

MSG ; Write Error Message

 W *7,!,"Answer YES or NO on whether you want to update the Dietetic"

 W !,"locations for inpatients.  This will insert the proper location"

 W !,"into the Dietetic Patient file for the appropriate admission."

 W !,"NOTE: During installation, the Dietetic locations for inpatients"

 W !,"have been updated already and this option will update them again."

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---FHXWRD   1636     printed  Apr 09, 2024@20:53:02                                                                                                                                                                                                      Page 2

FHXWRD    ; HISC/REL/NCA - Update Patient Dietetic Ward ;8/7/95  15:13

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

EN1       ; Ask user whether they want to update

 +1        READ !!,"Update the Patient Dietetic Location? N// ",X:DTIME

           if '$TEST!(X["^")

               GOTO KIL

           if X=""

               SET X="N"

           DO TR^FH

 +2        IF $PIECE("YES",X,1)'=""

               IF $PIECE("NO",X,1)'=""

                   DO MSG

                   GOTO EN1

 +3        IF X?1"Y".E

               DO E1

               WRITE !!,"....Done"

 +4        GOTO KIL

E1        ; Process Updating Patient Dietetic Ward

 +1        KILL ^FHPT("AW")

 +2        SET NX=""

           FOR 

               SET NX=$ORDER(^DPT("CN",NX))

               if NX=""

                   QUIT 

               FOR DFN=0:0

                   SET DFN=$ORDER(^DPT("CN",NX,DFN))

                   if DFN'>0

                       QUIT 

                   SET ADM=^(DFN)

                   DO SET

 +3        QUIT 

SET        DO DID^FHDPA

 +1        SET FHZ115="P"_DFN

           DO CHECK^FHOMDPA

           IF FHDFN=""

               QUIT 

 +2        if $DATA(^FHPT(FHDFN,"A",+ADM,0))#2=0

               QUIT 

 +3        SET Y=$PIECE(^FHPT(FHDFN,"A",ADM,0),"^",8,9)

           SET $PIECE(^(0),"^",8,9)=FHWRD_"^"_FHRMB

 +4        if FHWRD

               SET ^FHPT("AW",FHWRD,FHDFN)=ADM

 +5        IF (FHWRD_"^"_FHRMB)'=Y

               SET EVT="L^T^^"_$PIECE(Y,"^",1)_"~"_$PIECE(Y,"^",2)

               if FHWRD

                   SET EVT=EVT_"~"_FHWRD_"~"_FHRMB

               if 'FHWRD

                   SET $PIECE(EVT,"^",2)="D"

               DO ^FHORX

 +6        if 'FHWRD

               QUIT 

 +7       ; Update Type of Service

 +8        SET FHX3=$PIECE($GET(^FH(119.6,+FHWRD,0)),"^",10)

           if FHX3=""

               SET FHX3="TCD"

           IF FHX3[$PIECE(^FHPT(FHDFN,"A",ADM,0),"^",5)

               QUIT 

 +9        SET FHX3=$SELECT($LENGTH(FHX3)=1:FHX3,FHX3["D":"D",1:"C")

           SET $PIECE(^FHPT(FHDFN,"A",ADM,0),"^",5)=FHX3

 +10       SET FHX2=$PIECE(^FHPT(FHDFN,"A",ADM,0),"^",2)

           IF FHX2

               IF $PIECE($GET(^FHPT(FHDFN,"A",ADM,"DI",+FHX2,0)),"^",8)'=""

                   SET $PIECE(^(0),"^",8)=FHX3

 +11       QUIT 

KIL        GOTO KILL^XUSCLEAN

MSG       ; Write Error Message

 +1        WRITE *7,!,"Answer YES or NO on whether you want to update the Dietetic"

 +2        WRITE !,"locations for inpatients.  This will insert the proper location"

 +3        WRITE !,"into the Dietetic Patient file for the appropriate admission."

 +4        WRITE !,"NOTE: During installation, the Dietetic locations for inpatients"

 +5        WRITE !,"have been updated already and this option will update them again."

 +6        QUIT