- 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 Feb 18, 2025@23:36 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