LREPI4.m

LREPI4 ;VA/DALOI/SED-EMERGING PATHOGENS INPATIENT UPDATE ;5/1/98

 ;;5.2;LAB SERVICE;**1030**;NOV 01, 1997

 ;;5.2;LAB SERVICE;**132,175,260**;Sep 27, 1994;Build 2

 ; 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

 ;

LREPI4    ;VA/DALOI/SED-EMERGING PATHOGENS INPATIENT UPDATE ;5/1/98

 +1       ;;5.2;LAB SERVICE;**1030**;NOV 01, 1997

 +2       ;;5.2;LAB SERVICE;**132,175,260**;Sep 27, 1994;Build 2

 +3       ; Reference to ^DD supported by IA #999

 +4       ; 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      ;