- 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 Feb 19, 2025@00:00:28 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
