PSSSXRD ; BIR/PKR - Build indexes for drug files. ;08/30/2004
;;1.0;PHARMACY DATA MANAGEMENT;**62,89,170**;9/30/97;Build 5
;
;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 ;; << RJS*170
.. 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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSSSXRD 5000 printed Apr 09, 2024@21:35:12 Page 2
PSSSXRD ; BIR/PKR - Build indexes for drug files. ;08/30/2004
+1 ;;1.0;PHARMACY DATA MANAGEMENT;**62,89,170**;9/30/97;Build 5
+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 QUIT
+8 ;===============================================================
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
+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 (DFN,IND,NE,NERROR)=0
+15 FOR
SET DFN=+$ORDER(^PS(55,DFN))
if DFN=0
QUIT
Begin DoDot:1
+16 SET IND=IND+1
+17 IF IND#TENP=0
Begin DoDot:2
+18 SET TEXT="Processing entry "_IND
+19 DO MES^XPDUTL(TEXT)
End DoDot:2
+20 IF IND#10000=0
WRITE "."
+21 ;Process Unit Dose.
+22 SET DA=0
+23 FOR
SET DA=+$ORDER(^PS(55,DFN,5,DA))
if DA=0
QUIT
Begin DoDot:2
+24 SET TEMP=$GET(^PS(55,DFN,5,DA,2))
+25 SET STARTD=$PIECE(TEMP,U,2)
+26 IF STARTD=""
Begin DoDot:3
+27 SET IDEN="DFN="_DFN_" D1="_DA_" Unit Dose missing start date"
+28 DO ADDERROR^PXRMSXRM(GLOBAL,IDEN,.NERROR)
End DoDot:3
QUIT
+29 SET SDATE=$PIECE(TEMP,U,4)
+30 IF SDATE=1
QUIT
+31 IF SDATE=""
Begin DoDot:3
+32 SET IDEN="DFN="_DFN_" D1="_DA_" Unit Dose missing stop date"
+33 DO ADDERROR^PXRMSXRM(GLOBAL,IDEN,.NERROR)
End DoDot:3
QUIT
+34 SET DA1=0
+35 FOR
SET DA1=+$ORDER(^PS(55,DFN,5,DA,1,DA1))
if DA1=0
QUIT
Begin DoDot:3
+36 SET DRUG=$PIECE(^PS(55,DFN,5,DA,1,DA1,0),U,1)
+37 IF DRUG=""
Begin DoDot:4
+38 SET IDEN="DFN="_DFN_" D1="_DA_" D2="_DA1_" Unit Dose missing drug"
+39 DO ADDERROR^PXRMSXRM(GLOBAL,IDEN,.NERROR)
End DoDot:4
QUIT
+40 SET DAS=DFN_";5;"_DA_";1;"_DA1_";0"
+41 SET ^PXRMINDX(55,"IP",DRUG,DFN,STARTD,SDATE,DAS)=""
+42 SET ^PXRMINDX(55,"PI",DFN,DRUG,STARTD,SDATE,DAS)=""
+43 SET NE=NE+1
End DoDot:3
End DoDot:2
+44 ;Process the IV multiple.
+45 SET DA=0
+46 FOR
SET DA=+$ORDER(^PS(55,DFN,"IV",DA))
if DA=0
QUIT
Begin DoDot:2
+47 SET TEMP=$GET(^PS(55,DFN,"IV",DA,0))
+48 SET STARTD=$PIECE(TEMP,U,2)
+49 IF STARTD=""
Begin DoDot:3
+50 SET IDEN="DFN="_DFN_" D1="_DA_" IV missing start date"
+51 DO ADDERROR^PXRMSXRM(GLOBAL,IDEN,.NERROR)
End DoDot:3
QUIT
+52 SET SDATE=$PIECE(TEMP,U,3)
+53 IF SDATE=1
QUIT
+54 IF SDATE=""
Begin DoDot:3
+55 SET IDEN="DFN="_DFN_" D1="_DA_" IV missing stop date"
+56 DO ADDERROR^PXRMSXRM(GLOBAL,IDEN,.NERROR)
End DoDot:3
QUIT
+57 ;Process Additives
+58 SET DA1=0
+59 FOR
SET DA1=+$ORDER(^PS(55,DFN,"IV",DA,"AD",DA1))
if DA1=0
QUIT
Begin DoDot:3
+60 SET ADD=$PIECE(^PS(55,DFN,"IV",DA,"AD",DA1,0),U,1)
+61 IF ADD=""
Begin DoDot:4
+62 SET IDEN="DFN="_DFN_" D1="_DA_" D2="_DA1_" IV missing additive"
+63 DO ADDERROR^PXRMSXRM(GLOBAL,IDEN,.NERROR)
End DoDot:4
QUIT
+64 SET DRUG=$PIECE($GET(^PS(52.6,ADD,0)),U,2)
+65 IF DRUG=""
Begin DoDot:4
+66 SET IDEN="DFN="_DFN_" D1="_DA_" D2="_DA1_" IV additive missing drug"
+67 DO ADDERROR^PXRMSXRM(GLOBAL,IDEN,.NERROR)
End DoDot:4
QUIT
+68 SET NE=NE+1
+69 SET DAS=DFN_";IV;"_DA_";AD;"_DA1_";0"
+70 SET ^PXRMINDX(55,"IP",DRUG,DFN,STARTD,SDATE,DAS)=""
+71 SET ^PXRMINDX(55,"PI",DFN,DRUG,STARTD,SDATE,DAS)=""
End DoDot:3
+72 ;Process Solutions
+73 SET DA1=0
+74 FOR
SET DA1=+$ORDER(^PS(55,DFN,"IV",DA,"SOL",DA1))
if DA1=0
QUIT
Begin DoDot:3
+75 SET SOL=$PIECE(^PS(55,DFN,"IV",DA,"SOL",DA1,0),U,1)
+76 IF SOL=""
Begin DoDot:4
+77 SET IDEN="DFN="_DFN_" D1="_DA_" D2="_DA1_" IV-SOL missing solution"
+78 DO ADDERROR^PXRMSXRM(GLOBAL,IDEN,.NERROR)
End DoDot:4
QUIT
+79 SET DRUG=$PIECE($GET(^PS(52.7,SOL,0)),U,2)
+80 IF DRUG=""
Begin DoDot:4
+81 SET IDEN="DFN="_DFN_" D1="_DA_" D2="_DA1_" IV-SOL missing Drug"
+82 DO ADDERROR^PXRMSXRM(GLOBAL,IDEN,.NERROR)
End DoDot:4
QUIT
+83 SET NE=NE+1
+84 SET DAS=DFN_";IV;"_DA_";SOL;"_DA1_";0"
+85 SET ^PXRMINDX(55,"IP",DRUG,DFN,STARTD,SDATE,DAS)=""
+86 SET ^PXRMINDX(55,"PI",DFN,DRUG,STARTD,SDATE,DAS)=""
End DoDot:3
End DoDot:2
+87 ;Process the NVA multiple.
+88 SET DA=0
+89 FOR
SET DA=+$ORDER(^PS(55,DFN,"NVA",DA))
if DA=0
QUIT
Begin DoDot:2
+90 SET TEMP=$GET(^PS(55,DFN,"NVA",DA,0))
+91 SET STARTD=$PIECE(TEMP,U,9)
+92 IF STARTD=""
SET STARTD=$PIECE(TEMP,U,10)
+93 IF STARTD=""
Begin DoDot:3
+94 SET IDEN="DFN="_DFN_" D1="_DA_" NVA missing start date"
+95 DO ADDERROR^PXRMSXRM(GLOBAL,IDEN,.NERROR)
End DoDot:3
QUIT
+96 SET SDATE=$PIECE(TEMP,U,7)
+97 ;; << RJS*170
IF SDATE=""
SET SDATE="U"_DFN
+98 SET DAS=DFN_";NVA;"_DA_";0"
+99 SET POI=$PIECE(TEMP,U,1)
+100 SET ^PXRMINDX("55NVA","IP",POI,DFN,STARTD,SDATE,DAS)=""
+101 SET ^PXRMINDX("55NVA","PI",DFN,POI,STARTD,SDATE,DAS)=""
End DoDot:2
End DoDot:1
+102 SET END=$HOROLOG
+103 SET TEXT=NE_" PHARMACY PATIENTS results indexed."
+104 DO MES^XPDUTL(TEXT)
+105 SET TEXT=NERROR_" errors were encountered."
+106 DO MES^XPDUTL(TEXT)
+107 DO DETIME^PXRMSXRM(START,END)
+108 ;If there were errors send a message.
+109 IF NERROR>0
DO ERRMSG^PXRMSXRM(NERROR,GLOBAL)
+110 ;Send a MailMan message with the results.
+111 DO COMMSG^PXRMSXRM(GLOBAL,START,END,NE,NERROR)
+112 SET ^PXRMINDX(55,"GLOBAL NAME")=$$GET1^DID(55,"","","GLOBAL NAME")
+113 SET ^PXRMINDX(55,"BUILT BY")=DUZ
+114 SET ^PXRMINDX(55,"DATE BUILT")=$$NOW^XLFDT
+115 SET ^PXRMINDX("55NVA","GLOBAL NAME")=^PXRMINDX(55,"GLOBAL NAME")
+116 SET ^PXRMINDX("55NVA","BUILT BY")=^PXRMINDX(55,"BUILT BY")
+117 SET ^PXRMINDX("55NVA","DATE BUILT")=^PXRMINDX(55,"DATE BUILT")
+118 QUIT
