PSJXRFS.m

PSJXRFS ; SLC/PKR - Routines for setting 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

 ;

SPSPA(X,DA,NODE) ;Set index for Pharmacy Patient File.

 ;X(1)=START DATE/TIME;X(2)=STOP DATE/TIME

 ;The possible values for NODE are "IV" and "UD".

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

 S DFN=DA(1)

 ;Process UNIT DOSE entries.

 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"

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

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

 ;Process IV node entries.

 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"

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

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

 .;Process solutions.

 . 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"

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

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

 Q

PSJXRFS   ; SLC/PKR - Routines for setting 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       ;

SPSPA(X,DA,NODE) ;Set index for Pharmacy Patient File.

 +1       ;X(1)=START DATE/TIME;X(2)=STOP DATE/TIME

 +2       ;The possible values for NODE are "IV" and "UD".

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

 +4        SET DFN=DA(1)

 +5       ;Process UNIT DOSE entries.

 +6        IF NODE="UD"

               Begin DoDot:1

 +7                SET IND=0

 +8                FOR 

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

                       IF IND=0

                           QUIT 

                       Begin DoDot:2

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

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

 +11                       SET ^PXRMINDX(55,"IP",DRUG,DFN,X(1),X(2),DAS)=""

 +12                       SET ^PXRMINDX(55,"PI",DFN,DRUG,X(1),X(2),DAS)=""

                       End DoDot:2

               End DoDot:1

               QUIT 

 +13      ;Process IV node entries.

 +14       IF NODE="IV"

               Begin DoDot:1

 +15      ;Process additives.

 +16               SET IND=0

 +17               FOR 

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

                       IF IND=0

                           QUIT 

                       Begin DoDot:2

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

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

 +20                       IF DRUG=""

                               QUIT 

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

 +22                       SET ^PXRMINDX(55,"IP",DRUG,DFN,X(1),X(2),DAS)=""

 +23                       SET ^PXRMINDX(55,"PI",DFN,DRUG,X(1),X(2),DAS)=""

                       End DoDot:2

 +24      ;Process solutions.

 +25               SET IND=0

 +26               FOR 

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

                       IF IND=0

                           QUIT 

                       Begin DoDot:2

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

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

 +29                       IF DRUG=""

                               QUIT 

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

 +31                       SET ^PXRMINDX(55,"IP",DRUG,DFN,X(1),X(2),DAS)=""

 +32                       SET ^PXRMINDX(55,"PI",DFN,DRUG,X(1),X(2),DAS)=""

                       End DoDot:2

               End DoDot:1

 +33       QUIT