- 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 Mar 13, 2025@21:00:15 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
