| [613] | 1 | FHXCNV ; HISC/REL - Convert OE/RR to MAS 5 Admissions ;11/17/90 13:09
|
|---|
| 2 | ;;5.5;DIETETICS;;Jan 28, 2005
|
|---|
| 3 | S CUT="",ORIFN=$O(^OR(100,0)) I ORIFN>0 S CUT=$P($G(^OR(100,ORIFN,0)),"^",7)
|
|---|
| 4 | I CUT<1 W !!,"There do not appear to be any OE/RR orders. Conversion NOT necessary.",!! Q
|
|---|
| 5 | S Y=CUT,CUT=CUT\1 X ^DD("DD") W !!,"The first OE/RR order was entered ",Y
|
|---|
| 6 | W !,"Admissions not discharged before this date will be converted.",!
|
|---|
| 7 | F FHDFN=.9:0 S FHDFN=$O(^FHPT(FHDFN)) Q:FHDFN<1 F ADM=0:0 S ADM=$O(^FHPT(FHDFN,"A",ADM)) Q:ADM<1 D ADM
|
|---|
| 8 | KIL K CUT,FHDFN,DFN,ADM,FHDR,ORIFN,Y Q
|
|---|
| 9 | ADM S Y=$P($G(^DGPM(ADM,0)),"^",17) S:Y>0 Y=$P($G(^DGPM(+Y,0)),"^",1)
|
|---|
| 10 | I Y,Y<CUT Q
|
|---|
| 11 | S ORIFN=$P($G(^FHPT(FHDFN,"A",ADM,0)),"^",13) I ORIFN>0 D SET
|
|---|
| 12 | F FHDR=0:0 S FHDR=$O(^FHPT(FHDFN,"A",ADM,"DI",FHDR)) Q:FHDR<1 S ORIFN=$P($G(^(FHDR,0)),"^",14) I ORIFN>0 D SET
|
|---|
| 13 | F FHDR=0:0 S FHDR=$O(^FHPT(FHDFN,"A",ADM,"OO",FHDR)) Q:FHDR<1 S ORIFN=$P($G(^(FHDR,0)),"^",8) I ORIFN>0 D SET
|
|---|
| 14 | F FHDR=0:0 S FHDR=$O(^FHPT(FHDFN,"A",ADM,"EL",FHDR)) Q:FHDR<1 S ORIFN=$P($G(^(FHDR,0)),"^",7) I ORIFN>0 D SET
|
|---|
| 15 | F FHDR=0:0 S FHDR=$O(^FHPT(FHDFN,"A",ADM,"DR",FHDR)) Q:FHDR<1 S ORIFN=$P($G(^(FHDR,0)),"^",13) I ORIFN>0 D SET
|
|---|
| 16 | F FHDR=0:0 S FHDR=$O(^FHPT(FHDFN,"A",ADM,"TF",FHDR)) Q:FHDR<1 S ORIFN=$P($G(^(FHDR,0)),"^",14) I ORIFN>0 D SET
|
|---|
| 17 | Q
|
|---|
| 18 | SET I $D(^OR(100,ORIFN,4)) S $P(^(4),"^",1)=ADM
|
|---|
| 19 | Q
|
|---|
