PSSSXRD ; BIR/PKR - Build indexes for drug files. ;08/30/2004 ;;1.0;PHARMACY DATA MANAGEMENT;**62,89**;9/30/97 ; ;Reference to ^PXRMINDX supported by DBIA #4114 ;Reference to ADDERROR^PXRMSXRM supported by DBIA #4113 ;Reference to DETIME^PXRMSXRM supported by DBIA #4113 ;Reference to COMMSG^PXRMSXRM supported by DBIA #4113 Q ;=============================================================== PSPA ;Build the index for the Pharmacy Patient File. N ADD,DA,DA1,DAS,DATE,DFN,DRUG,END,ENTRIES,GLOBAL,IDEN,IND,INS,NE N NERROR,POI,SDATE,SOL,START,STARTD,TEMP,TENP,TEXT S GLOBAL=$$GET1^DID(55,"","","GLOBAL NAME") ;Don't leave any old stuff around. K ^PXRMINDX(55),^PXRMINDX("55NVA") S ENTRIES=$P(^PS(55,0),U,4) S TENP=ENTRIES/10 S TENP=+$P(TENP,".",1) I TENP<1 S TENP=1 D BMES^XPDUTL("Building indexes for PHARMACY PATIENT FILE") S TEXT="There are "_ENTRIES_" entries to process." D MES^XPDUTL(TEXT) S START=$H S (DFN,IND,NE,NERROR)=0 F S DFN=+$O(^PS(55,DFN)) Q:DFN=0 D . S IND=IND+1 . I IND#TENP=0 D .. S TEXT="Processing entry "_IND .. D MES^XPDUTL(TEXT) . I IND#10000=0 W "." .;Process Unit Dose. . S DA=0 . F S DA=+$O(^PS(55,DFN,5,DA)) Q:DA=0 D .. S TEMP=$G(^PS(55,DFN,5,DA,2)) .. S STARTD=$P(TEMP,U,2) .. I STARTD="" D Q ... S IDEN="DFN="_DFN_" D1="_DA_" Unit Dose missing start date" ... D ADDERROR^PXRMSXRM(GLOBAL,IDEN,.NERROR) .. S SDATE=$P(TEMP,U,4) .. I SDATE=1 Q .. I SDATE="" D Q ... S IDEN="DFN="_DFN_" D1="_DA_" Unit Dose missing stop date" ... D ADDERROR^PXRMSXRM(GLOBAL,IDEN,.NERROR) .. S DA1=0 .. F S DA1=+$O(^PS(55,DFN,5,DA,1,DA1)) Q:DA1=0 D ... S DRUG=$P(^PS(55,DFN,5,DA,1,DA1,0),U,1) ... I DRUG="" D Q .... S IDEN="DFN="_DFN_" D1="_DA_" D2="_DA1_" Unit Dose missing drug" .... D ADDERROR^PXRMSXRM(GLOBAL,IDEN,.NERROR) ... S DAS=DFN_";5;"_DA_";1;"_DA1_";0" ... S ^PXRMINDX(55,"IP",DRUG,DFN,STARTD,SDATE,DAS)="" ... S ^PXRMINDX(55,"PI",DFN,DRUG,STARTD,SDATE,DAS)="" ... S NE=NE+1 .;Process the IV multiple. . S DA=0 . F S DA=+$O(^PS(55,DFN,"IV",DA)) Q:DA=0 D .. S TEMP=$G(^PS(55,DFN,"IV",DA,0)) .. S STARTD=$P(TEMP,U,2) .. I STARTD="" D Q ... S IDEN="DFN="_DFN_" D1="_DA_" IV missing start date" ... D ADDERROR^PXRMSXRM(GLOBAL,IDEN,.NERROR) .. S SDATE=$P(TEMP,U,3) .. I SDATE=1 Q .. I SDATE="" D Q ... S IDEN="DFN="_DFN_" D1="_DA_" IV missing stop date" ... D ADDERROR^PXRMSXRM(GLOBAL,IDEN,.NERROR) ..;Process Additives .. S DA1=0 .. F S DA1=+$O(^PS(55,DFN,"IV",DA,"AD",DA1)) Q:DA1=0 D ... S ADD=$P(^PS(55,DFN,"IV",DA,"AD",DA1,0),U,1) ... I ADD="" D Q .... S IDEN="DFN="_DFN_" D1="_DA_" D2="_DA1_" IV missing additive" .... D ADDERROR^PXRMSXRM(GLOBAL,IDEN,.NERROR) ... S DRUG=$P($G(^PS(52.6,ADD,0)),U,2) ... I DRUG="" D Q .... S IDEN="DFN="_DFN_" D1="_DA_" D2="_DA1_" IV additive missing drug" .... D ADDERROR^PXRMSXRM(GLOBAL,IDEN,.NERROR) ... S NE=NE+1 ... S DAS=DFN_";IV;"_DA_";AD;"_DA1_";0" ... S ^PXRMINDX(55,"IP",DRUG,DFN,STARTD,SDATE,DAS)="" ... S ^PXRMINDX(55,"PI",DFN,DRUG,STARTD,SDATE,DAS)="" ..;Process Solutions .. S DA1=0 .. F S DA1=+$O(^PS(55,DFN,"IV",DA,"SOL",DA1)) Q:DA1=0 D ... S SOL=$P(^PS(55,DFN,"IV",DA,"SOL",DA1,0),U,1) ... I SOL="" D Q .... S IDEN="DFN="_DFN_" D1="_DA_" D2="_DA1_" IV-SOL missing solution" .... D ADDERROR^PXRMSXRM(GLOBAL,IDEN,.NERROR) ... S DRUG=$P($G(^PS(52.7,SOL,0)),U,2) ... I DRUG="" D Q .... S IDEN="DFN="_DFN_" D1="_DA_" D2="_DA1_" IV-SOL missing Drug" .... D ADDERROR^PXRMSXRM(GLOBAL,IDEN,.NERROR) ... S NE=NE+1 ... S DAS=DFN_";IV;"_DA_";SOL;"_DA1_";0" ... S ^PXRMINDX(55,"IP",DRUG,DFN,STARTD,SDATE,DAS)="" ... S ^PXRMINDX(55,"PI",DFN,DRUG,STARTD,SDATE,DAS)="" .;Process the NVA multiple. . S DA=0 . F S DA=+$O(^PS(55,DFN,"NVA",DA)) Q:DA=0 D .. S TEMP=$G(^PS(55,DFN,"NVA",DA,0)) .. S STARTD=$P(TEMP,U,9) .. I STARTD="" S STARTD=$P(TEMP,U,10) .. I STARTD="" D Q ... S IDEN="DFN="_DFN_" D1="_DA_" NVA missing start date" ... D ADDERROR^PXRMSXRM(GLOBAL,IDEN,.NERROR) .. S SDATE=$P(TEMP,U,7) .. I SDATE="" S SDATE="U"_DFN_DA .. S DAS=DFN_";NVA;"_DA_";0" .. S POI=$P(TEMP,U,1) .. S ^PXRMINDX("55NVA","IP",POI,DFN,STARTD,SDATE,DAS)="" .. S ^PXRMINDX("55NVA","PI",DFN,POI,STARTD,SDATE,DAS)="" S END=$H S TEXT=NE_" PHARMACY PATIENTS results indexed." D MES^XPDUTL(TEXT) S TEXT=NERROR_" errors were encountered." D MES^XPDUTL(TEXT) D DETIME^PXRMSXRM(START,END) ;If there were errors send a message. I NERROR>0 D ERRMSG^PXRMSXRM(NERROR,GLOBAL) ;Send a MailMan message with the results. D COMMSG^PXRMSXRM(GLOBAL,START,END,NE,NERROR) S ^PXRMINDX(55,"GLOBAL NAME")=$$GET1^DID(55,"","","GLOBAL NAME") S ^PXRMINDX(55,"BUILT BY")=DUZ S ^PXRMINDX(55,"DATE BUILT")=$$NOW^XLFDT S ^PXRMINDX("55NVA","GLOBAL NAME")=^PXRMINDX(55,"GLOBAL NAME") S ^PXRMINDX("55NVA","BUILT BY")=^PXRMINDX(55,"BUILT BY") S ^PXRMINDX("55NVA","DATE BUILT")=^PXRMINDX(55,"DATE BUILT") Q