- LREPI4 ;DALOI/SED-EMERGING PATHOGENS INPATIENT UPDATE ;5/1/98
- ;;5.2;LAB SERVICE;**132,175,260**;Sep 27, 1994
- ; Reference to ^DD supported by IA #999
- ; Reference to ^DGPT supported by IA #418
- CHECK ;CHECKS TO SEE IF PRIOR TO INPATIENT DISCHARGE
- Q:VAIN(10)=""
- Q:$P($G(^DGPT(VAIN(10),0)),U,6)=3
- Q:LRRTYPE
- SET ;SETS THE PTF RECORD FOR THE ENCOUNTER ONLY FOR AUTO RUNS
- Q:$D(^LAB(69.5,LRPATH,7,"B",VAIN(10)))
- K DD
- S DIC="^LAB(69.5,"_LRPATH_",7,",DIC(0)="L",X=VAIN(10),DLAYGO=69.5
- S DIC("P")=$P(^DD(69.5,14,0),U,2),DA(1)=LRPATH
- D FILE^DICN
- K DD,DO,DIC,DA,DLAYGO,X,Y
- Q
- SEARCH ;LOOKS AT THE ENTRIES TO DETERMINE DISCHARGES
- S LRPATH=0 F S LRPATH=$O(^TMP($J,"LREPI",LRPATH)) Q:LRPATH'>0 D
- .S LRPTF=0 F S LRPTF=$O(^LAB(69.5,LRPATH,7,"B",LRPTF)) Q:+LRPTF'>0 D
- ..Q:$P($G(^DGPT(LRPTF,0)),U,6)'=3 ;Added $G to cure undef problems
- ..S DA=0 F DA=$O(^LAB(69.5,LRPATH,7,"B",LRPTF,DA)) Q:+DA'>0 D
- ...Q:$P(^LAB(69.5,LRPATH,7,DA,0),U,2)'=""&($E($P(^LAB(69.5,LRPATH,7,DA,0),U,2),1,5)'=$E(LRRPS,1,5))
- ...S LRPROT=$P(^LAB(69.5,LRPATH,0),U,7)
- ...S LRPAT=$P(^DGPT(LRPTF,0),U,1),LRENCDT=$P(^DGPT(LRPTF,0),U,2)
- ...Q:LRENCDT>LRRPE
- ...S ^TMP($J,LRPROT,LRPAT,LRENCDT)="I"_U_LRPTF_U_"UPDT"
- ...;NOW DATE THE ENTRY(S) THAT WERE UPDATED FOR AUTO RUN ONLY
- ...Q:LRRTYPE
- ...S:$P(^LAB(69.5,LRPATH,7,DA,0),U,2)="" $P(^LAB(69.5,LRPATH,7,DA,0),U,2)=LRRPS
- K LRPATH,LRPTF,DA,LRPROT,LRPAT,LRENCDT
- Q
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLREPI4 1420 printed Feb 18, 2025@23:40:07 Page 2
- LREPI4 ;DALOI/SED-EMERGING PATHOGENS INPATIENT UPDATE ;5/1/98
- +1 ;;5.2;LAB SERVICE;**132,175,260**;Sep 27, 1994
- +2 ; Reference to ^DD supported by IA #999
- +3 ; Reference to ^DGPT supported by IA #418
- CHECK ;CHECKS TO SEE IF PRIOR TO INPATIENT DISCHARGE
- +1 if VAIN(10)=""
- QUIT
- +2 if $PIECE($GET(^DGPT(VAIN(10),0)),U,6)=3
- QUIT
- +3 if LRRTYPE
- QUIT
- SET ;SETS THE PTF RECORD FOR THE ENCOUNTER ONLY FOR AUTO RUNS
- +1 if $DATA(^LAB(69.5,LRPATH,7,"B",VAIN(10)))
- QUIT
- +2 KILL DD
- +3 SET DIC="^LAB(69.5,"_LRPATH_",7,"
- SET DIC(0)="L"
- SET X=VAIN(10)
- SET DLAYGO=69.5
- +4 SET DIC("P")=$PIECE(^DD(69.5,14,0),U,2)
- SET DA(1)=LRPATH
- +5 DO FILE^DICN
- +6 KILL DD,DO,DIC,DA,DLAYGO,X,Y
- +7 QUIT
- SEARCH ;LOOKS AT THE ENTRIES TO DETERMINE DISCHARGES
- +1 SET LRPATH=0
- FOR
- SET LRPATH=$ORDER(^TMP($JOB,"LREPI",LRPATH))
- if LRPATH'>0
- QUIT
- Begin DoDot:1
- +2 SET LRPTF=0
- FOR
- SET LRPTF=$ORDER(^LAB(69.5,LRPATH,7,"B",LRPTF))
- if +LRPTF'>0
- QUIT
- Begin DoDot:2
- +3 ;Added $G to cure undef problems
- if $PIECE($GET(^DGPT(LRPTF,0)),U,6)'=3
- QUIT
- +4 SET DA=0
- FOR DA=$ORDER(^LAB(69.5,LRPATH,7,"B",LRPTF,DA))
- if +DA'>0
- QUIT
- Begin DoDot:3
- +5 if $PIECE(^LAB(69.5,LRPATH,7,DA,0),U,2)'=""&($EXTRACT($PIECE(^LAB(69.5,LRPATH,7,DA,0),U,2),1,5)'=$EXTRACT(LRRPS,1,5))
- QUIT
- +6 SET LRPROT=$PIECE(^LAB(69.5,LRPATH,0),U,7)
- +7 SET LRPAT=$PIECE(^DGPT(LRPTF,0),U,1)
- SET LRENCDT=$PIECE(^DGPT(LRPTF,0),U,2)
- +8 if LRENCDT>LRRPE
- QUIT
- +9 SET ^TMP($JOB,LRPROT,LRPAT,LRENCDT)="I"_U_LRPTF_U_"UPDT"
- +10 ;NOW DATE THE ENTRY(S) THAT WERE UPDATED FOR AUTO RUN ONLY
- +11 if LRRTYPE
- QUIT
- +12 if $PIECE(^LAB(69.5,LRPATH,7,DA,0),U,2)=""
- SET $PIECE(^LAB(69.5,LRPATH,7,DA,0),U,2)=LRRPS
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +13 KILL LRPATH,LRPTF,DA,LRPROT,LRPAT,LRENCDT
- +14 QUIT
- +15 ;