PSSSPD ;BIR/RLW-PRINT/CREATE PHARMACY ORDERABLE ITEMS ; 09/01/98 7:13
;;1.0;PHARMACY DATA MANAGEMENT;**15**;9/30/97
EN ;
; name-spaced variables: ADD=iv additive file SOL=iv solution file
; PD=primary drug file DD=dispense drug file
; NDF=national drug file DF=NDF dosage form
; SPD=pharmacy orderable item file
N ADDIEN,ADDNAME,CHR,DDIEN,PDIEN,PDNAME,NDF,NDFVA,DF,DDNAME,DFNAME,SPDNAME,X,PGN,PSMATCH,SOLIEN,SOLNAME,SPD,SPDFN,CML,LIVE
;
S (PDIEN,DDIEN,NDF,X)=0,CHR=$S($G(PSCREATE):"~",1:" ")
K ^TMP("PSSD",$J),^TMP("PSS",$J),^TMP("PSSADD",$J),^TMP("PSSOL",$J)
LOOP ; loop through dispense drugs for each primary drug, get NDF entry
F S PDIEN=$O(^PSDRUG("AP",PDIEN)) Q:'PDIEN!('$D(^PS(50.3,+PDIEN,0))) S PDNAME=$P(^PS(50.3,PDIEN,0),"^"),DDIEN="" D
.F S DDIEN=$O(^PSDRUG("AP",PDIEN,DDIEN)) Q:'DDIEN!('$D(^PSDRUG(+DDIEN,0)))!($P($G(^PSDRUG(+DDIEN,0)),"^")="") D
..D DOSE I DFNAME="",'$G(PSCREATE) S ^TMP("PSSD",$J,"ZZZZ",DDNAME)="NDF link missing or incomplete" Q
..S:DFNAME]"" ^TMP("PSSD",$J,PDNAME_CHR_DFNAME,DDNAME)=PDNAME,^TMP("PSS",$J,DDNAME)=PDNAME_" "_DFNAME
;
IVADD ; IV Additives
S ADDIEN=0 F S ADDIEN=$O(^PS(52.6,ADDIEN)) Q:ADDIEN="" D
.S DDIEN=$P($G(^PS(52.6,ADDIEN,0)),"^",2) Q:DDIEN=""!('$D(^PSDRUG(+DDIEN,0))) S ADDNAME=$P($G(^PS(52.6,ADDIEN,0)),"^")
.D DOSE I DFNAME="",'$G(PSCREATE) S ^TMP("PSSADD",$J,"ZZZZ",DDNAME)="NDF link missing or incomplete" Q
.S:DFNAME]"" ^TMP("PSSADD",$J,ADDNAME,DDNAME)=DFNAME
;
IVSOL ; IV solutions
S (SOLNAME,SOLIEN)="" F S SOLNAME=$O(^PS(52.7,"B",SOLNAME)) Q:SOLNAME="" S SOLIEN="" F S SOLIEN=$O(^PS(52.7,"B",SOLNAME,SOLIEN)) Q:SOLIEN="" D
.S DDIEN=$P($G(^PS(52.7,SOLIEN,0)),"^",2) Q:DDIEN=""!('$D(^PSDRUG(+DDIEN,0))) D DOSE I DFNAME="",'$G(PSCREATE) S ^TMP("PSSOL",$J,"ZZZZ",DDNAME)="NDF link missing or incomplete" Q
.S:DFNAME]"" ^TMP("PSSOL",$J,SOLNAME,DFNAME,DDNAME)=SOLIEN
; if PSCREATE is defined, load the Pharmacy Orderable Item file from the ^TMP global
D:$G(PSCREATE) ^PSSPOI
Q
;
DOSE ; get dispense drug name and NDF dosage form
S (DF,DFNAME)="",DDNAME=$P(^PSDRUG(DDIEN,0),"^"),NDF=$G(^PSDRUG(DDIEN,"ND")) S DA=$P($G(NDF),"^"),X=$$VAGN^PSNAPIS(DA),GEN=X,K=$P($G(NDF),"^",3),X=$$PSJDF^PSNAPIS(DA,K),NDFVAGN=X,X=$$PROD0^PSNAPIS(DA,K),PROD=X D
.Q:($P(NDF,"^")="")!(GEN=0)
.Q:($P(NDF,"^",3)="")!(PROD']"")
.I GEN'=0 D
..; get pointer to dosage form file from VA PRODUCT NAME node
..Q:NDFVAGN=0 D
...S DF=$P(NDFVAGN,"^") Q:DF=0
...S DFNAME=$P(NDFVAGN,"^",2)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSSSPD 2576 printed Apr 09, 2024@21:35:24 Page 2
PSSSPD ;BIR/RLW-PRINT/CREATE PHARMACY ORDERABLE ITEMS ; 09/01/98 7:13
+1 ;;1.0;PHARMACY DATA MANAGEMENT;**15**;9/30/97
EN ;
+1 ; name-spaced variables: ADD=iv additive file SOL=iv solution file
+2 ; PD=primary drug file DD=dispense drug file
+3 ; NDF=national drug file DF=NDF dosage form
+4 ; SPD=pharmacy orderable item file
+5 NEW ADDIEN,ADDNAME,CHR,DDIEN,PDIEN,PDNAME,NDF,NDFVA,DF,DDNAME,DFNAME,SPDNAME,X,PGN,PSMATCH,SOLIEN,SOLNAME,SPD,SPDFN,CML,LIVE
+6 ;
+7 SET (PDIEN,DDIEN,NDF,X)=0
SET CHR=$SELECT($GET(PSCREATE):"~",1:" ")
+8 KILL ^TMP("PSSD",$JOB),^TMP("PSS",$JOB),^TMP("PSSADD",$JOB),^TMP("PSSOL",$JOB)
LOOP ; loop through dispense drugs for each primary drug, get NDF entry
+1 FOR
SET PDIEN=$ORDER(^PSDRUG("AP",PDIEN))
if 'PDIEN!('$DATA(^PS(50.3,+PDIEN,0)))
QUIT
SET PDNAME=$PIECE(^PS(50.3,PDIEN,0),"^")
SET DDIEN=""
Begin DoDot:1
+2 FOR
SET DDIEN=$ORDER(^PSDRUG("AP",PDIEN,DDIEN))
if 'DDIEN!('$DATA(^PSDRUG(+DDIEN,0)))!($PIECE($GET(^PSDRUG(+DDIEN,0)),"^")="")
QUIT
Begin DoDot:2
+3 DO DOSE
IF DFNAME=""
IF '$GET(PSCREATE)
SET ^TMP("PSSD",$JOB,"ZZZZ",DDNAME)="NDF link missing or incomplete"
QUIT
+4 if DFNAME]""
SET ^TMP("PSSD",$JOB,PDNAME_CHR_DFNAME,DDNAME)=PDNAME
SET ^TMP("PSS",$JOB,DDNAME)=PDNAME_" "_DFNAME
End DoDot:2
End DoDot:1
+5 ;
IVADD ; IV Additives
+1 SET ADDIEN=0
FOR
SET ADDIEN=$ORDER(^PS(52.6,ADDIEN))
if ADDIEN=""
QUIT
Begin DoDot:1
+2 SET DDIEN=$PIECE($GET(^PS(52.6,ADDIEN,0)),"^",2)
if DDIEN=""!('$DATA(^PSDRUG(+DDIEN,0)))
QUIT
SET ADDNAME=$PIECE($GET(^PS(52.6,ADDIEN,0)),"^")
+3 DO DOSE
IF DFNAME=""
IF '$GET(PSCREATE)
SET ^TMP("PSSADD",$JOB,"ZZZZ",DDNAME)="NDF link missing or incomplete"
QUIT
+4 if DFNAME]""
SET ^TMP("PSSADD",$JOB,ADDNAME,DDNAME)=DFNAME
End DoDot:1
+5 ;
IVSOL ; IV solutions
+1 SET (SOLNAME,SOLIEN)=""
FOR
SET SOLNAME=$ORDER(^PS(52.7,"B",SOLNAME))
if SOLNAME=""
QUIT
SET SOLIEN=""
FOR
SET SOLIEN=$ORDER(^PS(52.7,"B",SOLNAME,SOLIEN))
if SOLIEN=""
QUIT
Begin DoDot:1
+2 SET DDIEN=$PIECE($GET(^PS(52.7,SOLIEN,0)),"^",2)
if DDIEN=""!('$DATA(^PSDRUG(+DDIEN,0)))
QUIT
DO DOSE
IF DFNAME=""
IF '$GET(PSCREATE)
SET ^TMP("PSSOL",$JOB,"ZZZZ",DDNAME)="NDF link missing or incomplete"
QUIT
+3 if DFNAME]""
SET ^TMP("PSSOL",$JOB,SOLNAME,DFNAME,DDNAME)=SOLIEN
End DoDot:1
+4 ; if PSCREATE is defined, load the Pharmacy Orderable Item file from the ^TMP global
+5 if $GET(PSCREATE)
DO ^PSSPOI
+6 QUIT
+7 ;
DOSE ; get dispense drug name and NDF dosage form
+1 SET (DF,DFNAME)=""
SET DDNAME=$PIECE(^PSDRUG(DDIEN,0),"^")
SET NDF=$GET(^PSDRUG(DDIEN,"ND"))
SET DA=$PIECE($GET(NDF),"^")
SET X=$$VAGN^PSNAPIS(DA)
SET GEN=X
SET K=$PIECE($GET(NDF),"^",3)
SET X=$$PSJDF^PSNAPIS(DA,K)
SET NDFVAGN=X
SET X=$$PROD0^PSNAPIS(DA,K)
SET PROD=X
Begin DoDot:1
+2 if ($PIECE(NDF,"^")="")!(GEN=0)
QUIT
+3 if ($PIECE(NDF,"^",3)="")!(PROD']"")
QUIT
+4 IF GEN'=0
Begin DoDot:2
+5 ; get pointer to dosage form file from VA PRODUCT NAME node
+6 if NDFVAGN=0
QUIT
Begin DoDot:3
+7 SET DF=$PIECE(NDFVAGN,"^")
if DF=0
QUIT
+8 SET DFNAME=$PIECE(NDFVAGN,"^",2)
End DoDot:3
End DoDot:2
End DoDot:1
+9 QUIT
