- PSSPOIM ;BIR/RTR-Orderable Items by VA Generic Name only ; 09/01/98 7:11
- ;;1.0;PHARMACY DATA MANAGEMENT;**15**;9/30/97
- ;K ^TMP("PSSD",$J)
- I '$G(PSMATCH) G CANT
- ;VA Generic Name only that can match
- BEG F RRR=0:0 S RRR=$O(^PSDRUG(RRR)) Q:'RRR D
- .K NODE,PSONAME,PSOPTR
- .S NODE=$G(^PSDRUG(RRR,"ND")),PSONAME=$P($G(^(0)),"^"),PSOPTR=$P($G(^(2)),"^"),DA=$P(NODE,"^"),K=$P(NODE,"^",3),X=$$PSJDF^PSNAPIS(DA,K),DOSE1=X
- .Q:PSONAME=""
- .I +PSOPTR Q
- .I '$P(NODE,"^") Q
- .;Next 5 lines of code could only apply if this report is run and
- .;there are Dispensed drugs that are already matched
- .K ^TMP($J,"PSSUP") I +$P(NODE,"^"),+$P(NODE,"^",3) F GG=0:0 S GG=$O(^PSDRUG("AND",+NODE,GG)) Q:'GG I +$P($G(^PSDRUG(GG,2)),"^"),$D(^PS(50.7,$P(^PSDRUG(GG,2),"^"),0)) D
- ..S ONO=$G(^PSDRUG(GG,"ND")) I +$P(ONO,"^"),+$P(ONO,"^",3),DOSE1'=0 S DA=$P($G(ONO),"^"),K=$P($G(ONO),"^",3),X=$$PSJDF^PSNAPIS(DA,K),DOSE2=X I DOSE2'=0 D
- ...I DOSE1=DOSE2 S ^TMP($J,"PSSUP",GG)=$P(^PSDRUG(GG,2),"^")
- .S (COM,COMSUP)=0 I $O(^TMP($J,"PSSUP",0)) S COM=1 S FF=$O(^TMP($J,"PSSUP",0)),SUPER=^TMP($J,"PSSUP",FF) F FF=0:0 S FF=$O(^TMP($J,"PSSUP",FF)) Q:'FF I SUPER'=^TMP($J,"PSSUP",FF) S COMSUP=1
- .I COM,COMSUP Q
- .I COM,'COMSUP S SSS=$O(^TMP($J,"PSSUP",0)),SSS=^TMP($J,"PSSUP",SSS) S ^TMP("PSSD",$J,$P($G(^PS(50.7,SUPER,0)),"^")_" "_$P($G(^PS(50.606,+$P($G(^PS(50.7,SSS,0)),"^",2),0)),"^"),PSONAME)="" Q
- .I +$P(NODE,"^"),+$P(NODE,"^",3) S DA=$P($G(NODE),"^"),X=$$VAGN^PSNAPIS(DA),VAG=X I VAG'=0,DOSE1'=0 D
- ..I $L(VAG)<41 S ^TMP("PSSD",$J,$P(DOSE1,"^",2),PSONAME)=""
- END K ^TMP($J,"PSSUP"),APPL,COM,COMSUP,FF,GG,NODE,ONO,POINAME,PSOPTR,PSPTR,RRR,SSS,SUPER Q
- CANT ;Generic name only, cannot match
- K ^TMP("PSSD",$J,"ZZZZ")
- F ZZ=0:0 S ZZ=$O(^PSDRUG(ZZ)) Q:'ZZ D I TMPFLAG S ^TMP("PSSD",$J,"ZZZZ",PSDNAME)=REASON
- .K PTDOS,DOSEF,REASON
- .S PSND=$G(^PSDRUG(ZZ,"ND")),PSDNAME=$P($G(^(0)),"^"),PSOPRT=$P($G(^(2)),"^"),TMPFLAG=0 S DA=$P($G(PSND),"^"),K=$P($G(PSND),"^",3),X=$$PSJDF^PSNAPIS(DA,K),DSE=X,X=$$VAGN^PSNAPIS(DA),GN1=X
- .I +PSOPRT Q
- .S PSQFLAG=0 I +$P(PSND,"^"),+$P(PSND,"^",3),GN1'=0,DSE'=0 D
- ..I DSE'=0,$D(^PS(50.606,$P(DSE,"^"),0)),$L(GN1)<41 S PSQFLAG=1
- .I PSQFLAG Q
- .S TMPFLAG=1
- .I $P(PSND,"^")="" S REASON="NDF link missing or incomplete" Q
- .I $P(PSND,"^",3)="" S REASON="No PSNDF VA Product Name Entry" Q
- .I GN1=0 S REASON="Invalid National Drug File entry" Q
- .S PSVA=$P(PSND,"^",3),DA=$P(PSND,"^"),K=PSVA,X=$$PROD0^PSNAPIS(DA,K) I X']"" S REASON="Invalid PSNDF VA Product Name Entry" Q
- .I DSE=0 S REASON="No Dosage Form Entry in NDF" Q
- .I DSE=0 S REASON="Missing Dosage Form in NDF" Q
- .I DSE=0 S REASON="Invalid entry in Dosage Form File" Q
- .I $L(GN1)>40 S REASON="Generic name greater than 40 characters" Q
- .S REASON="Undertermined problem" Q
- DONE K DOSEFORM,DOSEPTR,PSAPP,PSDNAME,PSND,PSQFLAG,PSVA,TMPFLAG,ZZ Q
- PSSPOIM ;BIR/RTR-Orderable Items by VA Generic Name only ; 09/01/98 7:11
- +1 ;;1.0;PHARMACY DATA MANAGEMENT;**15**;9/30/97
- +2 ;K ^TMP("PSSD",$J)
- +3 IF '$GET(PSMATCH)
- GOTO CANT
- +4 ;VA Generic Name only that can match
- BEG FOR RRR=0:0
- SET RRR=$ORDER(^PSDRUG(RRR))
- IF 'RRR
- QUIT
- Begin DoDot:1
- +1 KILL NODE,PSONAME,PSOPTR
- +2 SET NODE=$GET(^PSDRUG(RRR,"ND"))
- SET PSONAME=$PIECE($GET(^(0)),"^")
- SET PSOPTR=$PIECE($GET(^(2)),"^")
- SET DA=$PIECE(NODE,"^")
- SET K=$PIECE(NODE,"^",3)
- SET X=$$PSJDF^PSNAPIS(DA,K)
- SET DOSE1=X
- +3 IF PSONAME=""
- QUIT
- +4 IF +PSOPTR
- QUIT
- +5 IF '$PIECE(NODE,"^")
- QUIT
- +6 ;Next 5 lines of code could only apply if this report is run and
- +7 ;there are Dispensed drugs that are already matched
- +8 KILL ^TMP($JOB,"PSSUP")
- IF +$PIECE(NODE,"^")
- IF +$PIECE(NODE,"^",3)
- FOR GG=0:0
- SET GG=$ORDER(^PSDRUG("AND",+NODE,GG))
- IF 'GG
- QUIT
- IF +$PIECE($GET(^PSDRUG(GG,2)),"^")
- IF $DATA(^PS(50.7,$PIECE(^PSDRUG(GG,2),"^"),0))
- Begin DoDot:2
- +9 SET ONO=$GET(^PSDRUG(GG,"ND"))
- IF +$PIECE(ONO,"^")
- IF +$PIECE(ONO,"^",3)
- IF DOSE1'=0
- SET DA=$PIECE($GET(ONO),"^")
- SET K=$PIECE($GET(ONO),"^",3)
- SET X=$$PSJDF^PSNAPIS(DA,K)
- SET DOSE2=X
- IF DOSE2'=0
- Begin DoDot:3
- +10 IF DOSE1=DOSE2
- SET ^TMP($JOB,"PSSUP",GG)=$PIECE(^PSDRUG(GG,2),"^")
- End DoDot:3
- End DoDot:2
- +11 SET (COM,COMSUP)=0
- IF $ORDER(^TMP($JOB,"PSSUP",0))
- SET COM=1
- SET FF=$ORDER(^TMP($JOB,"PSSUP",0))
- SET SUPER=^TMP($JOB,"PSSUP",FF)
- FOR FF=0:0
- SET FF=$ORDER(^TMP($JOB,"PSSUP",FF))
- IF 'FF
- QUIT
- IF SUPER'=^TMP($JOB,"PSSUP",FF)
- SET COMSUP=1
- +12 IF COM
- IF COMSUP
- QUIT
- +13 IF COM
- IF 'COMSUP
- SET SSS=$ORDER(^TMP($JOB,"PSSUP",0))
- SET SSS=^TMP($JOB,"PSSUP",SSS)
- SET ^TMP("PSSD",$JOB,$PIECE($GET(^PS(50.7,SUPER,0)),"^")_" "_$PIECE($GET(^PS(50.606,+$PIECE($GET(^PS(50.7,SSS,0)),"^",2),0)),"^"),PSONAME)=""
- QUIT
- +14 IF +$PIECE(NODE,"^")
- IF +$PIECE(NODE,"^",3)
- SET DA=$PIECE($GET(NODE),"^")
- SET X=$$VAGN^PSNAPIS(DA)
- SET VAG=X
- IF VAG'=0
- IF DOSE1'=0
- Begin DoDot:2
- +15 IF $LENGTH(VAG)<41
- SET ^TMP("PSSD",$JOB,$PIECE(DOSE1,"^",2),PSONAME)=""
- End DoDot:2
- End DoDot:1
- END KILL ^TMP($JOB,"PSSUP"),APPL,COM,COMSUP,FF,GG,NODE,ONO,POINAME,PSOPTR,PSPTR,RRR,SSS,SUPER
- QUIT
- CANT ;Generic name only, cannot match
- +1 KILL ^TMP("PSSD",$JOB,"ZZZZ")
- +2 FOR ZZ=0:0
- SET ZZ=$ORDER(^PSDRUG(ZZ))
- IF 'ZZ
- QUIT
- Begin DoDot:1
- +3 KILL PTDOS,DOSEF,REASON
- +4 SET PSND=$GET(^PSDRUG(ZZ,"ND"))
- SET PSDNAME=$PIECE($GET(^(0)),"^")
- SET PSOPRT=$PIECE($GET(^(2)),"^")
- SET TMPFLAG=0
- SET DA=$PIECE($GET(PSND),"^")
- SET K=$PIECE($GET(PSND),"^",3)
- SET X=$$PSJDF^PSNAPIS(DA,K)
- SET DSE=X
- SET X=$$VAGN^PSNAPIS(DA)
- SET GN1=X
- +5 IF +PSOPRT
- QUIT
- +6 SET PSQFLAG=0
- IF +$PIECE(PSND,"^")
- IF +$PIECE(PSND,"^",3)
- IF GN1'=0
- IF DSE'=0
- Begin DoDot:2
- +7 IF DSE'=0
- IF $DATA(^PS(50.606,$PIECE(DSE,"^"),0))
- IF $LENGTH(GN1)<41
- SET PSQFLAG=1
- End DoDot:2
- +8 IF PSQFLAG
- QUIT
- +9 SET TMPFLAG=1
- +10 IF $PIECE(PSND,"^")=""
- SET REASON="NDF link missing or incomplete"
- QUIT
- +11 IF $PIECE(PSND,"^",3)=""
- SET REASON="No PSNDF VA Product Name Entry"
- QUIT
- +12 IF GN1=0
- SET REASON="Invalid National Drug File entry"
- QUIT
- +13 SET PSVA=$PIECE(PSND,"^",3)
- SET DA=$PIECE(PSND,"^")
- SET K=PSVA
- SET X=$$PROD0^PSNAPIS(DA,K)
- IF X']""
- SET REASON="Invalid PSNDF VA Product Name Entry"
- QUIT
- +14 IF DSE=0
- SET REASON="No Dosage Form Entry in NDF"
- QUIT
- +15 IF DSE=0
- SET REASON="Missing Dosage Form in NDF"
- QUIT
- +16 IF DSE=0
- SET REASON="Invalid entry in Dosage Form File"
- QUIT
- +17 IF $LENGTH(GN1)>40
- SET REASON="Generic name greater than 40 characters"
- QUIT
- +18 SET REASON="Undertermined problem"
- QUIT
- End DoDot:1
- IF TMPFLAG
- SET ^TMP("PSSD",$JOB,"ZZZZ",PSDNAME)=REASON
- DONE KILL DOSEFORM,DOSEPTR,PSAPP,PSDNAME,PSND,PSQFLAG,PSVA,TMPFLAG,ZZ
- QUIT
