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 ---[H[J[2J[HFHXWRD 1636 printed Nov 22, 2024@17:05:59 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
