PSSSXRD ; BIR/PKR - Build indexes for drug files. ;03-Oct-2012 13:22;DU
;;1.0;PHARMACY DATA MANAGEMENT;**62,89,1015**;9/30/97;Build 62
;
;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
;IHS/MSC/MGH add a check on order data and only send error message
;if date is less than a year ago
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,ODATE,YR,X1,X2,X
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 X1=$$NOW^XLFDT,X2=-365 D C^%DTC S YR=X
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))
.. Q:TEMP="" ;Patch 1015
.. S STARTD=$P(TEMP,U,2)
.. S ODATE=$P($G(^PS(55,DFN,5,DA,0)),U,14) ;Patch 1015
.. I STARTD="" D Q
...I ODATE>YR D ;Patch 1015
.... 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
...I ODATE>YR D ;Patch 1015
.... 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 ODATE=$P($G(^PS(55,DFN,"IV",DA,2)),U,1) ;Patch 1015
.. S STARTD=$P(TEMP,U,2)
.. I STARTD="" D Q
...I ODATE>YR D ;Patch 1015
.... 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
...I ODATE>YR D ;Patch 1015
.... 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
PSSSXRD ; BIR/PKR - Build indexes for drug files. ;03-Oct-2012 13:22;DU
+1 ;;1.0;PHARMACY DATA MANAGEMENT;**62,89,1015**;9/30/97;Build 62
+2 ;
+3 ;Reference to ^PXRMINDX supported by DBIA #4114
+4 ;Reference to ADDERROR^PXRMSXRM supported by DBIA #4113
+5 ;Reference to DETIME^PXRMSXRM supported by DBIA #4113
+6 ;Reference to COMMSG^PXRMSXRM supported by DBIA #4113
+7 ;IHS/MSC/MGH add a check on order data and only send error message
+8 ;if date is less than a year ago
+9 QUIT
+10 ;===============================================================
PSPA ;Build the index for the Pharmacy Patient File.
+1 NEW ADD,DA,DA1,DAS,DATE,DFN,DRUG,END,ENTRIES,GLOBAL,IDEN,IND,INS,NE
+2 NEW NERROR,POI,SDATE,SOL,START,STARTD,TEMP,TENP,TEXT,ODATE,YR,X1,X2,X
+3 SET GLOBAL=$$GET1^DID(55,"","","GLOBAL NAME")
+4 ;Don't leave any old stuff around.
+5 KILL ^PXRMINDX(55),^PXRMINDX("55NVA")
+6 SET ENTRIES=$PIECE(^PS(55,0),U,4)
+7 SET TENP=ENTRIES/10
+8 SET TENP=+$PIECE(TENP,".",1)
+9 IF TENP<1
SET TENP=1
+10 DO BMES^XPDUTL("Building indexes for PHARMACY PATIENT FILE")
+11 SET TEXT="There are "_ENTRIES_" entries to process."
+12 DO MES^XPDUTL(TEXT)
+13 SET START=$HOROLOG
+14 SET X1=$$NOW^XLFDT
SET X2=-365
DO C^%DTC
SET YR=X
+15 SET (DFN,IND,NE,NERROR)=0
+16 FOR
SET DFN=+$ORDER(^PS(55,DFN))
IF DFN=0
QUIT
Begin DoDot:1
+17 SET IND=IND+1
+18 IF IND#TENP=0
Begin DoDot:2
+19 SET TEXT="Processing entry "_IND
+20 DO MES^XPDUTL(TEXT)
End DoDot:2
+21 IF IND#10000=0
WRITE "."
+22 ;Process Unit Dose.
+23 SET DA=0
+24 FOR
SET DA=+$ORDER(^PS(55,DFN,5,DA))
IF DA=0
QUIT
Begin DoDot:2
+25 SET TEMP=$GET(^PS(55,DFN,5,DA,2))
+26 ;Patch 1015
IF TEMP=""
QUIT
+27 SET STARTD=$PIECE(TEMP,U,2)
+28 ;Patch 1015
SET ODATE=$PIECE($GET(^PS(55,DFN,5,DA,0)),U,14)
+29 IF STARTD=""
Begin DoDot:3
+30 ;Patch 1015
IF ODATE>YR
Begin DoDot:4
+31 SET IDEN="DFN="_DFN_" D1="_DA_" Unit Dose missing start date"
+32 DO ADDERROR^PXRMSXRM(GLOBAL,IDEN,.NERROR)
End DoDot:4
End DoDot:3
QUIT
+33 SET SDATE=$PIECE(TEMP,U,4)
+34 IF SDATE=1
QUIT
+35 IF SDATE=""
Begin DoDot:3
+36 ;Patch 1015
IF ODATE>YR
Begin DoDot:4
+37 SET IDEN="DFN="_DFN_" D1="_DA_" Unit Dose missing stop date"
+38 DO ADDERROR^PXRMSXRM(GLOBAL,IDEN,.NERROR)
End DoDot:4
End DoDot:3
QUIT
+39 SET DA1=0
+40 FOR
SET DA1=+$ORDER(^PS(55,DFN,5,DA,1,DA1))
IF DA1=0
QUIT
Begin DoDot:3
+41 SET DRUG=$PIECE(^PS(55,DFN,5,DA,1,DA1,0),U,1)
+42 IF DRUG=""
Begin DoDot:4
+43 SET IDEN="DFN="_DFN_" D1="_DA_" D2="_DA1_" Unit Dose missing drug"
+44 DO ADDERROR^PXRMSXRM(GLOBAL,IDEN,.NERROR)
End DoDot:4
QUIT
+45 SET DAS=DFN_";5;"_DA_";1;"_DA1_";0"
+46 SET ^PXRMINDX(55,"IP",DRUG,DFN,STARTD,SDATE,DAS)=""
+47 SET ^PXRMINDX(55,"PI",DFN,DRUG,STARTD,SDATE,DAS)=""
+48 SET NE=NE+1
End DoDot:3
End DoDot:2
+49 ;Process the IV multiple.
+50 SET DA=0
+51 FOR
SET DA=+$ORDER(^PS(55,DFN,"IV",DA))
IF DA=0
QUIT
Begin DoDot:2
+52 SET TEMP=$GET(^PS(55,DFN,"IV",DA,0))
+53 ;Patch 1015
SET ODATE=$PIECE($GET(^PS(55,DFN,"IV",DA,2)),U,1)
+54 SET STARTD=$PIECE(TEMP,U,2)
+55 IF STARTD=""
Begin DoDot:3
+56 ;Patch 1015
IF ODATE>YR
Begin DoDot:4
+57 SET IDEN="DFN="_DFN_" D1="_DA_" IV missing start date"
+58 DO ADDERROR^PXRMSXRM(GLOBAL,IDEN,.NERROR)
End DoDot:4
End DoDot:3
QUIT
+59 SET SDATE=$PIECE(TEMP,U,3)
+60 IF SDATE=1
QUIT
+61 IF SDATE=""
Begin DoDot:3
+62 ;Patch 1015
IF ODATE>YR
Begin DoDot:4
+63 SET IDEN="DFN="_DFN_" D1="_DA_" IV missing stop date"
+64 DO ADDERROR^PXRMSXRM(GLOBAL,IDEN,.NERROR)
End DoDot:4
End DoDot:3
QUIT
+65 ;Process Additives
+66 SET DA1=0
+67 FOR
SET DA1=+$ORDER(^PS(55,DFN,"IV",DA,"AD",DA1))
IF DA1=0
QUIT
Begin DoDot:3
+68 SET ADD=$PIECE(^PS(55,DFN,"IV",DA,"AD",DA1,0),U,1)
+69 IF ADD=""
Begin DoDot:4
+70 SET IDEN="DFN="_DFN_" D1="_DA_" D2="_DA1_" IV missing additive"
+71 DO ADDERROR^PXRMSXRM(GLOBAL,IDEN,.NERROR)
End DoDot:4
QUIT
+72 SET DRUG=$PIECE($GET(^PS(52.6,ADD,0)),U,2)
+73 IF DRUG=""
Begin DoDot:4
+74 SET IDEN="DFN="_DFN_" D1="_DA_" D2="_DA1_" IV additive missing drug"
+75 DO ADDERROR^PXRMSXRM(GLOBAL,IDEN,.NERROR)
End DoDot:4
QUIT
+76 SET NE=NE+1
+77 SET DAS=DFN_";IV;"_DA_";AD;"_DA1_";0"
+78 SET ^PXRMINDX(55,"IP",DRUG,DFN,STARTD,SDATE,DAS)=""
+79 SET ^PXRMINDX(55,"PI",DFN,DRUG,STARTD,SDATE,DAS)=""
End DoDot:3
+80 ;Process Solutions
+81 SET DA1=0
+82 FOR
SET DA1=+$ORDER(^PS(55,DFN,"IV",DA,"SOL",DA1))
IF DA1=0
QUIT
Begin DoDot:3
+83 SET SOL=$PIECE(^PS(55,DFN,"IV",DA,"SOL",DA1,0),U,1)
+84 IF SOL=""
Begin DoDot:4
+85 SET IDEN="DFN="_DFN_" D1="_DA_" D2="_DA1_" IV-SOL missing solution"
+86 DO ADDERROR^PXRMSXRM(GLOBAL,IDEN,.NERROR)
End DoDot:4
QUIT
+87 SET DRUG=$PIECE($GET(^PS(52.7,SOL,0)),U,2)
+88 IF DRUG=""
Begin DoDot:4
+89 SET IDEN="DFN="_DFN_" D1="_DA_" D2="_DA1_" IV-SOL missing Drug"
+90 DO ADDERROR^PXRMSXRM(GLOBAL,IDEN,.NERROR)
End DoDot:4
QUIT
+91 SET NE=NE+1
+92 SET DAS=DFN_";IV;"_DA_";SOL;"_DA1_";0"
+93 SET ^PXRMINDX(55,"IP",DRUG,DFN,STARTD,SDATE,DAS)=""
+94 SET ^PXRMINDX(55,"PI",DFN,DRUG,STARTD,SDATE,DAS)=""
End DoDot:3
End DoDot:2
+95 ;Process the NVA multiple.
+96 SET DA=0
+97 FOR
SET DA=+$ORDER(^PS(55,DFN,"NVA",DA))
IF DA=0
QUIT
Begin DoDot:2
+98 SET TEMP=$GET(^PS(55,DFN,"NVA",DA,0))
+99 SET STARTD=$PIECE(TEMP,U,9)
+100 IF STARTD=""
SET STARTD=$PIECE(TEMP,U,10)
+101 IF STARTD=""
Begin DoDot:3
+102 SET IDEN="DFN="_DFN_" D1="_DA_" NVA missing start date"
+103 DO ADDERROR^PXRMSXRM(GLOBAL,IDEN,.NERROR)
End DoDot:3
QUIT
+104 SET SDATE=$PIECE(TEMP,U,7)
+105 IF SDATE=""
SET SDATE="U"_DFN_DA
+106 SET DAS=DFN_";NVA;"_DA_";0"
+107 SET POI=$PIECE(TEMP,U,1)
+108 SET ^PXRMINDX("55NVA","IP",POI,DFN,STARTD,SDATE,DAS)=""
+109 SET ^PXRMINDX("55NVA","PI",DFN,POI,STARTD,SDATE,DAS)=""
End DoDot:2
End DoDot:1
+110 SET END=$HOROLOG
+111 SET TEXT=NE_" PHARMACY PATIENTS results indexed."
+112 DO MES^XPDUTL(TEXT)
+113 SET TEXT=NERROR_" errors were encountered."
+114 DO MES^XPDUTL(TEXT)
+115 DO DETIME^PXRMSXRM(START,END)
+116 ;If there were errors send a message.
+117 IF NERROR>0
DO ERRMSG^PXRMSXRM(NERROR,GLOBAL)
+118 ;Send a MailMan message with the results.
+119 DO COMMSG^PXRMSXRM(GLOBAL,START,END,NE,NERROR)
+120 SET ^PXRMINDX(55,"GLOBAL NAME")=$$GET1^DID(55,"","","GLOBAL NAME")
+121 SET ^PXRMINDX(55,"BUILT BY")=DUZ
+122 SET ^PXRMINDX(55,"DATE BUILT")=$$NOW^XLFDT
+123 SET ^PXRMINDX("55NVA","GLOBAL NAME")=^PXRMINDX(55,"GLOBAL NAME")
+124 SET ^PXRMINDX("55NVA","BUILT BY")=^PXRMINDX(55,"BUILT BY")
+125 SET ^PXRMINDX("55NVA","DATE BUILT")=^PXRMINDX(55,"DATE BUILT")
+126 QUIT
