- 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
