source: WorldVistAEHR/trunk/r/DIETETICS-FH/FHWORP.m@ 949

Last change on this file since 949 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.3 KB
Line 
1FHWORP ; HISC/NCA - Order Entry 3 Data Conversion ;7/1/97 16:45
2 ;;5.5;DIETETICS;;Jan 28, 2005
3 I +$$VERSION^XPDUTL("OR")'=3 Q
4 Q:'$D(^OR(100,0)) D NOW^%DTC S FHNOW=%
5Q1 ; Process Converting Active Dietetics Orders
6 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
7EXIT G KIL
8CVT ; Start Converting the OE/RR Data
9 Q:'$D(^FHPT(FHDFN,"A",ADM,0))
10 S FHX1=$G(^FHPT(FHDFN,"A",ADM,0))
11 S FHORD=$P(FHX1,"^",2) D:FHORD DO
12 S TF=$P(FHX1,"^",4) D:TF TF
13 S IS=$P(FHX1,"^",10) D:IS IS
14 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
15 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)=""
16 F FHORN=0:0 S FHORN=$O(N(FHORN)) Q:FHORN<1 D EL
17 Q
18AO ; Convert Additional Orders
19 S FHORN=$P(Y,"^",8) Q:'FHORN
20 S VAL=$G(^OR(100,FHORN,4)),VAL1="" Q:VAL=""!($E(VAL,1)="A") D VAL(VAL,.VAL1)
21 S DATA="A;"_VAL1
22 D FH^ORCONV3(FHORN,DATA)
23 Q
24DO ; Convert Current Diet Order or NPO
25 S FHORN=$P($G(^FHPT(FHDFN,"A",ADM,"DI",FHORD,0)),"^",14) Q:'FHORN
26 S TYP=$P($G(^FHPT(FHDFN,"A",ADM,"DI",FHORD,0)),"^",7) I 'TYP!(TYP="N") D DO1
27 S SDT=$P($G(^FHPT(FHDFN,"A",ADM,"DI",FHORD,0)),"^",9)
28 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
29 Q
30DO1 S FHORN=$P($G(^FHPT(FHDFN,"A",ADM,"DI",FHORD,0)),"^",14) Q:'FHORN
31 S VAL=$G(^OR(100,FHORN,4)),VAL1="" Q:VAL=""!($E(VAL,1)="D")!($E(VAL,1)="N") D VAL(VAL,.VAL1)
32 S DATA=$S(TYP="N":"N;",1:"D;")_VAL1
33 D FH^ORCONV3(FHORN,DATA)
34 Q
35EL ; Convert Early/Late Tray
36 S VAL=$G(^OR(100,FHORN,4)),VAL1="" Q:VAL=""!($E(VAL,1)="E") D VAL(VAL,.VAL1)
37 S DATA="E;"_VAL1
38 D FH^ORCONV3(FHORN,DATA)
39 Q
40TF ; Convert Current Tubefeeding
41 S FHORN=$P($G(^FHPT(FHDFN,"A",ADM,"TF",TF,0)),"^",14) Q:'FHORN
42 S VAL=$G(^OR(100,FHORN,4)),VAL1="" Q:VAL=""!($E(VAL,1)="T") D VAL(VAL,.VAL1)
43 S DATA="T;"_VAL1
44 D FH^ORCONV3(FHORN,DATA)
45 Q
46IS ; Convert Isolation/Precaution
47 S FHORN=$P(FHX1,"^",13) Q:'FHORN
48 S VAL=$G(^OR(100,FHORN,4)),VAL1="" Q:VAL=""!($E(VAL,1)="I") D VAL(VAL,.VAL1)
49 S DATA="I;"_VAL1
50 D FH^ORCONV3(FHORN,DATA)
51 Q
52KIL K %,%DT,ADM,FHDFN,DATA,EL,FHAO,FHNOW,FHORD,FHORN,FHVAL,FHW1,FHX1,IS,FHKK,N,SDT,TF,TYP,VAL,VAL1,X4,XX,Y
53 Q
54VAL(VAL,FHVAL) ; Translate all up arrows to semicolons
55 S FHVAL=$TR(VAL,"^",";")
56 Q
Note: See TracBrowser for help on using the repository browser.