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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSJXRFS 1599 printed Dec 13, 2024@02:09:38 Page 2
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
