- 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 Mar 13, 2025@21:39:02 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
