FHWORP ; HISC/NCA - Order Entry 3 Data Conversion ;7/1/97 16:45
;;5.5;DIETETICS;;Jan 28, 2005
I +$$VERSION^XPDUTL("OR")'=3 Q
Q:'$D(^OR(100,0)) D NOW^%DTC S FHNOW=%
Q1 ; Process Converting Active Dietetics Orders
F FHW1=0:0 S FHW1=$O(^FHPT("AW",FHW1)) Q:FHW1<1 F FHDFN=0:0 S FHDFN=$O(^FHPT("AW",FHW1,FHDFN)) Q:FHDFN<1 S ADM=$G(^FHPT("AW",FHW1,FHDFN)) D CVT
EXIT G KIL
CVT ; Start Converting the OE/RR Data
Q:'$D(^FHPT(FHDFN,"A",ADM,0))
S FHX1=$G(^FHPT(FHDFN,"A",ADM,0))
S FHORD=$P(FHX1,"^",2) D:FHORD DO
S TF=$P(FHX1,"^",4) D:TF TF
S IS=$P(FHX1,"^",10) D:IS IS
F FHAO=0:0 S FHAO=$O(^FHPT("AOO",FHDFN,ADM,FHAO)) Q:FHAO<1 S Y=$G(^FHPT(FHDFN,"A",ADM,"OO",FHAO,0)) D AO
K N F EL=FHNOW:0 S EL=$O(^FHPT(FHDFN,"A",ADM,"EL",EL)) Q:EL<1 S Y=$G(^(EL,0)),FHORN=$P(Y,"^",7) I FHORN S:'$D(N(FHORN)) N(FHORN)=""
F FHORN=0:0 S FHORN=$O(N(FHORN)) Q:FHORN<1 D EL
Q
AO ; Convert Additional Orders
S FHORN=$P(Y,"^",8) Q:'FHORN
S VAL=$G(^OR(100,FHORN,4)),VAL1="" Q:VAL=""!($E(VAL,1)="A") D VAL(VAL,.VAL1)
S DATA="A;"_VAL1
D FH^ORCONV3(FHORN,DATA)
Q
DO ; Convert Current Diet Order or NPO
S FHORN=$P($G(^FHPT(FHDFN,"A",ADM,"DI",FHORD,0)),"^",14) Q:'FHORN
S TYP=$P($G(^FHPT(FHDFN,"A",ADM,"DI",FHORD,0)),"^",7) I 'TYP!(TYP="N") D DO1
S SDT=$P($G(^FHPT(FHDFN,"A",ADM,"DI",FHORD,0)),"^",9)
F FHKK=SDT:0 S FHKK=$O(^FHPT(FHDFN,"A",ADM,"AC",FHKK)) Q:FHKK<1 S Y=$G(^(FHKK,0)),FHORD=$P(Y,"^",2) D DO1
Q
DO1 S FHORN=$P($G(^FHPT(FHDFN,"A",ADM,"DI",FHORD,0)),"^",14) Q:'FHORN
S VAL=$G(^OR(100,FHORN,4)),VAL1="" Q:VAL=""!($E(VAL,1)="D")!($E(VAL,1)="N") D VAL(VAL,.VAL1)
S DATA=$S(TYP="N":"N;",1:"D;")_VAL1
D FH^ORCONV3(FHORN,DATA)
Q
EL ; Convert Early/Late Tray
S VAL=$G(^OR(100,FHORN,4)),VAL1="" Q:VAL=""!($E(VAL,1)="E") D VAL(VAL,.VAL1)
S DATA="E;"_VAL1
D FH^ORCONV3(FHORN,DATA)
Q
TF ; Convert Current Tubefeeding
S FHORN=$P($G(^FHPT(FHDFN,"A",ADM,"TF",TF,0)),"^",14) Q:'FHORN
S VAL=$G(^OR(100,FHORN,4)),VAL1="" Q:VAL=""!($E(VAL,1)="T") D VAL(VAL,.VAL1)
S DATA="T;"_VAL1
D FH^ORCONV3(FHORN,DATA)
Q
IS ; Convert Isolation/Precaution
S FHORN=$P(FHX1,"^",13) Q:'FHORN
S VAL=$G(^OR(100,FHORN,4)),VAL1="" Q:VAL=""!($E(VAL,1)="I") D VAL(VAL,.VAL1)
S DATA="I;"_VAL1
D FH^ORCONV3(FHORN,DATA)
Q
KIL K %,%DT,ADM,FHDFN,DATA,EL,FHAO,FHNOW,FHORD,FHORN,FHVAL,FHW1,FHX1,IS,FHKK,N,SDT,TF,TYP,VAL,VAL1,X4,XX,Y
Q
VAL(VAL,FHVAL) ; Translate all up arrows to semicolons
S FHVAL=$TR(VAL,"^",";")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFHWORP 2457 printed Oct 16, 2024@17:56:27 Page 2
FHWORP ; HISC/NCA - Order Entry 3 Data Conversion ;7/1/97 16:45
+1 ;;5.5;DIETETICS;;Jan 28, 2005
+2 IF +$$VERSION^XPDUTL("OR")'=3
QUIT
+3 if '$DATA(^OR(100,0))
QUIT
DO NOW^%DTC
SET FHNOW=%
Q1 ; Process Converting Active Dietetics Orders
+1 FOR FHW1=0:0
SET FHW1=$ORDER(^FHPT("AW",FHW1))
if FHW1<1
QUIT
FOR FHDFN=0:0
SET FHDFN=$ORDER(^FHPT("AW",FHW1,FHDFN))
if FHDFN<1
QUIT
SET ADM=$GET(^FHPT("AW",FHW1,FHDFN))
DO CVT
EXIT GOTO KIL
CVT ; Start Converting the OE/RR Data
+1 if '$DATA(^FHPT(FHDFN,"A",ADM,0))
QUIT
+2 SET FHX1=$GET(^FHPT(FHDFN,"A",ADM,0))
+3 SET FHORD=$PIECE(FHX1,"^",2)
if FHORD
DO DO
+4 SET TF=$PIECE(FHX1,"^",4)
if TF
DO TF
+5 SET IS=$PIECE(FHX1,"^",10)
if IS
DO IS
+6 FOR FHAO=0:0
SET FHAO=$ORDER(^FHPT("AOO",FHDFN,ADM,FHAO))
if FHAO<1
QUIT
SET Y=$GET(^FHPT(FHDFN,"A",ADM,"OO",FHAO,0))
DO AO
+7 KILL N
FOR EL=FHNOW:0
SET EL=$ORDER(^FHPT(FHDFN,"A",ADM,"EL",EL))
if EL<1
QUIT
SET Y=$GET(^(EL,0))
SET FHORN=$PIECE(Y,"^",7)
IF FHORN
if '$DATA(N(FHORN))
SET N(FHORN)=""
+8 FOR FHORN=0:0
SET FHORN=$ORDER(N(FHORN))
if FHORN<1
QUIT
DO EL
+9 QUIT
AO ; Convert Additional Orders
+1 SET FHORN=$PIECE(Y,"^",8)
if 'FHORN
QUIT
+2 SET VAL=$GET(^OR(100,FHORN,4))
SET VAL1=""
if VAL=""!($EXTRACT(VAL,1)="A")
QUIT
DO VAL(VAL,.VAL1)
+3 SET DATA="A;"_VAL1
+4 DO FH^ORCONV3(FHORN,DATA)
+5 QUIT
DO ; Convert Current Diet Order or NPO
+1 SET FHORN=$PIECE($GET(^FHPT(FHDFN,"A",ADM,"DI",FHORD,0)),"^",14)
if 'FHORN
QUIT
+2 SET TYP=$PIECE($GET(^FHPT(FHDFN,"A",ADM,"DI",FHORD,0)),"^",7)
IF 'TYP!(TYP="N")
DO DO1
+3 SET SDT=$PIECE($GET(^FHPT(FHDFN,"A",ADM,"DI",FHORD,0)),"^",9)
+4 FOR FHKK=SDT:0
SET FHKK=$ORDER(^FHPT(FHDFN,"A",ADM,"AC",FHKK))
if FHKK<1
QUIT
SET Y=$GET(^(FHKK,0))
SET FHORD=$PIECE(Y,"^",2)
DO DO1
+5 QUIT
DO1 SET FHORN=$PIECE($GET(^FHPT(FHDFN,"A",ADM,"DI",FHORD,0)),"^",14)
if 'FHORN
QUIT
+1 SET VAL=$GET(^OR(100,FHORN,4))
SET VAL1=""
if VAL=""!($EXTRACT(VAL,1)="D")!($EXTRACT(VAL,1)="N")
QUIT
DO VAL(VAL,.VAL1)
+2 SET DATA=$SELECT(TYP="N":"N;",1:"D;")_VAL1
+3 DO FH^ORCONV3(FHORN,DATA)
+4 QUIT
EL ; Convert Early/Late Tray
+1 SET VAL=$GET(^OR(100,FHORN,4))
SET VAL1=""
if VAL=""!($EXTRACT(VAL,1)="E")
QUIT
DO VAL(VAL,.VAL1)
+2 SET DATA="E;"_VAL1
+3 DO FH^ORCONV3(FHORN,DATA)
+4 QUIT
TF ; Convert Current Tubefeeding
+1 SET FHORN=$PIECE($GET(^FHPT(FHDFN,"A",ADM,"TF",TF,0)),"^",14)
if 'FHORN
QUIT
+2 SET VAL=$GET(^OR(100,FHORN,4))
SET VAL1=""
if VAL=""!($EXTRACT(VAL,1)="T")
QUIT
DO VAL(VAL,.VAL1)
+3 SET DATA="T;"_VAL1
+4 DO FH^ORCONV3(FHORN,DATA)
+5 QUIT
IS ; Convert Isolation/Precaution
+1 SET FHORN=$PIECE(FHX1,"^",13)
if 'FHORN
QUIT
+2 SET VAL=$GET(^OR(100,FHORN,4))
SET VAL1=""
if VAL=""!($EXTRACT(VAL,1)="I")
QUIT
DO VAL(VAL,.VAL1)
+3 SET DATA="I;"_VAL1
+4 DO FH^ORCONV3(FHORN,DATA)
+5 QUIT
KIL KILL %,%DT,ADM,FHDFN,DATA,EL,FHAO,FHNOW,FHORD,FHORN,FHVAL,FHW1,FHX1,IS,FHKK,N,SDT,TF,TYP,VAL,VAL1,X4,XX,Y
+1 QUIT
VAL(VAL,FHVAL) ; Translate all up arrows to semicolons
+1 SET FHVAL=$TRANSLATE(VAL,"^",";")
+2 QUIT
