- FHXCNV ; HISC/REL - Convert OE/RR to MAS 5 Admissions ;11/17/90 13:09
- ;;5.5;DIETETICS;;Jan 28, 2005
- S CUT="",ORIFN=$O(^OR(100,0)) I ORIFN>0 S CUT=$P($G(^OR(100,ORIFN,0)),"^",7)
- I CUT<1 W !!,"There do not appear to be any OE/RR orders. Conversion NOT necessary.",!! Q
- S Y=CUT,CUT=CUT\1 X ^DD("DD") W !!,"The first OE/RR order was entered ",Y
- W !,"Admissions not discharged before this date will be converted.",!
- 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
- KIL K CUT,FHDFN,DFN,ADM,FHDR,ORIFN,Y Q
- ADM S Y=$P($G(^DGPM(ADM,0)),"^",17) S:Y>0 Y=$P($G(^DGPM(+Y,0)),"^",1)
- I Y,Y<CUT Q
- S ORIFN=$P($G(^FHPT(FHDFN,"A",ADM,0)),"^",13) I ORIFN>0 D SET
- 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
- 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
- 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
- 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
- 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
- Q
- SET I $D(^OR(100,ORIFN,4)) S $P(^(4),"^",1)=ADM
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFHXCNV 1344 printed Mar 13, 2025@21:00:18 Page 2
- FHXCNV ; HISC/REL - Convert OE/RR to MAS 5 Admissions ;11/17/90 13:09
- +1 ;;5.5;DIETETICS;;Jan 28, 2005
- +2 SET CUT=""
- SET ORIFN=$ORDER(^OR(100,0))
- IF ORIFN>0
- SET CUT=$PIECE($GET(^OR(100,ORIFN,0)),"^",7)
- +3 IF CUT<1
- WRITE !!,"There do not appear to be any OE/RR orders. Conversion NOT necessary.",!!
- QUIT
- +4 SET Y=CUT
- SET CUT=CUT\1
- XECUTE ^DD("DD")
- WRITE !!,"The first OE/RR order was entered ",Y
- +5 WRITE !,"Admissions not discharged before this date will be converted.",!
- +6 FOR FHDFN=.9:0
- SET FHDFN=$ORDER(^FHPT(FHDFN))
- if FHDFN<1
- QUIT
- FOR ADM=0:0
- SET ADM=$ORDER(^FHPT(FHDFN,"A",ADM))
- if ADM<1
- QUIT
- DO ADM
- KIL KILL CUT,FHDFN,DFN,ADM,FHDR,ORIFN,Y
- QUIT
- ADM SET Y=$PIECE($GET(^DGPM(ADM,0)),"^",17)
- if Y>0
- SET Y=$PIECE($GET(^DGPM(+Y,0)),"^",1)
- +1 IF Y
- IF Y<CUT
- QUIT
- +2 SET ORIFN=$PIECE($GET(^FHPT(FHDFN,"A",ADM,0)),"^",13)
- IF ORIFN>0
- DO SET
- +3 FOR FHDR=0:0
- SET FHDR=$ORDER(^FHPT(FHDFN,"A",ADM,"DI",FHDR))
- if FHDR<1
- QUIT
- SET ORIFN=$PIECE($GET(^(FHDR,0)),"^",14)
- IF ORIFN>0
- DO SET
- +4 FOR FHDR=0:0
- SET FHDR=$ORDER(^FHPT(FHDFN,"A",ADM,"OO",FHDR))
- if FHDR<1
- QUIT
- SET ORIFN=$PIECE($GET(^(FHDR,0)),"^",8)
- IF ORIFN>0
- DO SET
- +5 FOR FHDR=0:0
- SET FHDR=$ORDER(^FHPT(FHDFN,"A",ADM,"EL",FHDR))
- if FHDR<1
- QUIT
- SET ORIFN=$PIECE($GET(^(FHDR,0)),"^",7)
- IF ORIFN>0
- DO SET
- +6 FOR FHDR=0:0
- SET FHDR=$ORDER(^FHPT(FHDFN,"A",ADM,"DR",FHDR))
- if FHDR<1
- QUIT
- SET ORIFN=$PIECE($GET(^(FHDR,0)),"^",13)
- IF ORIFN>0
- DO SET
- +7 FOR FHDR=0:0
- SET FHDR=$ORDER(^FHPT(FHDFN,"A",ADM,"TF",FHDR))
- if FHDR<1
- QUIT
- SET ORIFN=$PIECE($GET(^(FHDR,0)),"^",14)
- IF ORIFN>0
- DO SET
- +8 QUIT
- SET IF $DATA(^OR(100,ORIFN,4))
- SET $PIECE(^(4),"^",1)=ADM
- +1 QUIT
