PSJXRFK.m

PSJXRFK ; SLC/PKR - Routines for killing indexes. ;24 Sep 03 / 1:17 PM

 ;;5.0;INPATIENT MEDICATIONS;**90**;16 DEC 97

 ;

 ;Reference to ^PS(52.6 is supported by DBIA# 1231.

 ;Reference to ^PS(55 is supported by DBIA# 2191.

 ;Reference to ^PS(52.7 is supported by DBIA# 2173.

 ;Reference to ^PXRMINDX(55 is supported by DBIA# 4114.

 Q

 ;

KPSPA(X,DA,NODE) ;Delete index for Pharmacy Patient File.

 N ADD,DAS,DFN,DRUG,IND,SOL

 S DFN=DA(1)

 I NODE="UD" D  Q

 . S IND=0

 . F  S IND=+$O(^PS(55,DA(1),5,DA,1,IND)) Q:IND=0  D

 .. S DRUG=$P(^PS(55,DA(1),5,DA,1,IND,0),U,1)

 .. S DAS=DA(1)_";5;"_DA_";1;"_IND_";0"

 .. K ^PXRMINDX(55,"IP",DRUG,DFN,X(1),X(2),DAS)

 .. K ^PXRMINDX(55,"PI",DFN,DRUG,X(1),X(2),DAS)

 I NODE="IV" D

 .;Process additives.

 . S IND=0

 . F  S IND=+$O(^PS(55,DA(1),"IV",DA,"AD",IND)) Q:IND=0  D

 .. S ADD=$P(^PS(55,DA(1),"IV",DA,"AD",IND,0),U,1)

 .. S DRUG=$P($G(^PS(52.6,ADD,0)),U,2)

 .. I DRUG="" Q

 .. S DAS=DA(1)_";IV;"_DA_";AD;"_IND_";0"

 .. K ^PXRMINDX(55,"IP",DRUG,DFN,X(1),X(2),DAS)

 .. K ^PXRMINDX(55,"PI",DFN,DRUG,X(1),X(2),DAS)

 . S IND=0

 . F  S IND=+$O(^PS(55,DA(1),"IV",DA,"SOL",IND)) Q:IND=0  D

 .. S SOL=$P(^PS(55,DA(1),"IV",DA,"SOL",IND,0),U,1)

 .. S DRUG=$P($G(^PS(52.7,SOL,0)),U,2)

 .. I DRUG="" Q

 .. S DAS=DA(1)_";IV;"_DA_";SOL;"_IND_";0"

 .. K ^PXRMINDX(55,"IP",DRUG,DFN,X(1),X(2),DAS)

 .. K ^PXRMINDX(55,"PI",DFN,DRUG,X(1),X(2),DAS)

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---PSJXRFK   1408     printed  Apr 09, 2024@21:11:56                                                                                                                                                                                                     Page 2

PSJXRFK   ; SLC/PKR - Routines for killing indexes. ;24 Sep 03 / 1:17 PM

 +1       ;;5.0;INPATIENT MEDICATIONS;**90**;16 DEC 97

 +2       ;

 +3       ;Reference to ^PS(52.6 is supported by DBIA# 1231.

 +4       ;Reference to ^PS(55 is supported by DBIA# 2191.

 +5       ;Reference to ^PS(52.7 is supported by DBIA# 2173.

 +6       ;Reference to ^PXRMINDX(55 is supported by DBIA# 4114.

 +7        QUIT 

 +8       ;

KPSPA(X,DA,NODE) ;Delete index for Pharmacy Patient File.

 +1        NEW ADD,DAS,DFN,DRUG,IND,SOL

 +2        SET DFN=DA(1)

 +3        IF NODE="UD"

               Begin DoDot:1

 +4                SET IND=0

 +5                FOR 

                       SET IND=+$ORDER(^PS(55,DA(1),5,DA,1,IND))

                       if IND=0

                           QUIT 

                       Begin DoDot:2

 +6                        SET DRUG=$PIECE(^PS(55,DA(1),5,DA,1,IND,0),U,1)

 +7                        SET DAS=DA(1)_";5;"_DA_";1;"_IND_";0"

 +8                        KILL ^PXRMINDX(55,"IP",DRUG,DFN,X(1),X(2),DAS)

 +9                        KILL ^PXRMINDX(55,"PI",DFN,DRUG,X(1),X(2),DAS)

                       End DoDot:2

               End DoDot:1

               QUIT 

 +10       IF NODE="IV"

               Begin DoDot:1

 +11      ;Process additives.

 +12               SET IND=0

 +13               FOR 

                       SET IND=+$ORDER(^PS(55,DA(1),"IV",DA,"AD",IND))

                       if IND=0

                           QUIT 

                       Begin DoDot:2

 +14                       SET ADD=$PIECE(^PS(55,DA(1),"IV",DA,"AD",IND,0),U,1)

 +15                       SET DRUG=$PIECE($GET(^PS(52.6,ADD,0)),U,2)

 +16                       IF DRUG=""

                               QUIT 

 +17                       SET DAS=DA(1)_";IV;"_DA_";AD;"_IND_";0"

 +18                       KILL ^PXRMINDX(55,"IP",DRUG,DFN,X(1),X(2),DAS)

 +19                       KILL ^PXRMINDX(55,"PI",DFN,DRUG,X(1),X(2),DAS)

                       End DoDot:2

 +20               SET IND=0

 +21               FOR 

                       SET IND=+$ORDER(^PS(55,DA(1),"IV",DA,"SOL",IND))

                       if IND=0

                           QUIT 

                       Begin DoDot:2

 +22                       SET SOL=$PIECE(^PS(55,DA(1),"IV",DA,"SOL",IND,0),U,1)

 +23                       SET DRUG=$PIECE($GET(^PS(52.7,SOL,0)),U,2)

 +24                       IF DRUG=""

                               QUIT 

 +25                       SET DAS=DA(1)_";IV;"_DA_";SOL;"_IND_";0"

 +26                       KILL ^PXRMINDX(55,"IP",DRUG,DFN,X(1),X(2),DAS)

 +27                       KILL ^PXRMINDX(55,"PI",DFN,DRUG,X(1),X(2),DAS)

                       End DoDot:2

               End DoDot:1

 +28       QUIT