- PSSPOIC ;BIR/RTR-Orderable items by VA Name after Primary ; 09/01/98 7:10
- ;;1.0;PHARMACY DATA MANAGEMENT;**15**;9/30/97
- I '$G(PSMATCH) G CANT
- ;VA Generic Name after Primary checks that can auto-match
- BEG F PPP=0:0 S PPP=$O(^PSDRUG(PPP)) Q:'PPP D
- .S NDNOD=$G(^PSDRUG(PPP,"ND")),PSODNAME=$P($G(^(0)),"^"),PRIPTR=$P($G(^(2)),"^",6),PSOIPTR=$P($G(^(2)),"^") S DA=$P($G(PSNDO),"^"),K=$P($G(PSNDO),"^",3),X=$$PSJDF^PSNAPIS(DA,K),DOFO=X
- .Q:PSODNAME=""
- .I $D(^TMP("PSS",$J,PSODNAME)) Q
- .I +PSOIPTR Q
- .K ^TMP($J,"PSSPP") I +$P(NDNOD,"^"),+$P(NDNOD,"^",3) F AA=0:0 S AA=$O(^PSDRUG("AND",+NDNOD,AA)) Q:'AA S OTHNAME=$P($G(^PSDRUG(AA,0)),"^") I $D(^TMP("PSS",$J,OTHNAME)) D
- ..S ONOD=$G(^PSDRUG(AA,"ND")) I +$P(ONOD,"^"),+$P(ONOD,"^",3),DOFO'=0 S DA=$P($G(ONOD),"^"),K=$P($G(ONOD),"^",3),X=$$PSJDF^PSNAPIS(DA,K),DOFO1=X I DOFO1'=0 D
- ...I DOFO=DOFO1 S ^TMP($J,"PSSPP",AA)=^TMP("PSS",$J,OTHNAME)
- .S (COMM,COMMSUP)=0 I $O(^TMP($J,"PSSPP",0)) S COMM=1 S WW=$O(^TMP($J,"PSSPP",0)),POII=^TMP($J,"PSSPP",WW) F WW=0:0 S WW=$O(^TMP($J,"PSSPP",WW)) Q:'WW I POII'=^TMP($J,"PSSPP",WW) S COMMSUP=1
- .I COMM,COMMSUP Q
- .I COMM,'COMMSUP S ZZZ=$O(^TMP($J,"PSSPP",0)),ZZZ=^TMP($J,"PSSPP",ZZZ) S ^TMP("PSSD",$J,ZZZ,PSODNAME)="" Q
- .I +$P(NDNOD,"^"),+$P(NDNOD,"^",3) S DA=$P($G(NDNOD),"^"),K=$P($G(NDNOD),"^",3),X=$$PSJDF^PSNAPIS(DA,K),D1F1=X I D1F1'=0 D
- ..S DA=$P($G(NDNOD),"^"),X=$$VAGN^PSNAPIS(DA),VAGN=X I $L(VAGN)<41 D
- ...S ^TMP("PSSD",$J,VAGN_" "_$P(D1F1,"^",2),PSODNAME)=""
- END K ^TMP($J,"PSSPP"),AA,APPU,COMM,COMMSUP,NDNOD,ONOD,OTHNAME,POII,PPP,PSOIPTR,PRIPTR,PSODF,PSODNAME,WW,ZZZ Q
- CANT ;Generic Name after Primary, can't match
- F LLL=0:0 S LLL=$O(^PSDRUG(LLL)) Q:'LLL D I TMPFLG S ^TMP("PSSD",$J,"ZZZZ",PSNAME)=RSN
- .K RSN,DOSFO,POTDOS
- .S PSNDO=$G(^PSDRUG(LLL,"ND")),PSNAME=$P($G(^(0)),"^"),PSPTR=$P($G(^(2)),"^"),PSPRIM=$P($G(^(2)),"^",6) S DA=$P($G(PSNDO),"^"),K=$P($G(PSNDO),"^",3),X=$$PSJDF^PSNAPIS(DA,K),FRM1=X,TMPFLG=0
- .I +PSPTR Q
- .;If Primary, ZZZZ or PSS
- .I $D(^TMP("PSS",$J,PSNAME)) Q
- .K ^TMP($J,"PSSO") I +$P(PSNDO,"^"),+$P(PSNDO,"^",3) F BB=0:0 S BB=$O(^PSDRUG("AND",+PSNDO,BB)) Q:'BB S OTHER=$P($G(^PSDRUG(BB,0)),"^") I $D(^TMP("PSS",$J,OTHER)) D
- ..S OTNO=$G(^PSDRUG(BB,"ND")) I +$P(OTNO,"^"),+$P(OTNO,"^",3),FRM1'=0 S DA=$P($G(OTNO),"^"),K=$P($G(OTNO),"^",3),X=$$PSJDF^PSNAPIS(DA,K),FRM2=X I FRM2'=0 D
- ...I FRM1=FRM2 D
- ....S SAME=0,POINAME=^TMP("PSS",$J,OTHER) F III=0:0 S III=$O(^TMP($J,"PSSO",III)) Q:'III I POINAME=^(III) S SAME=1
- ....I 'SAME S ^TMP($J,"PSSO",BB)=^TMP("PSS",$J,OTHER)
- .S PSCOMMD=0 I $O(^TMP($J,"PSSO",0)) S TTT=$O(^TMP($J,"PSSO",0)),ORDNAM=^TMP($J,"PSSO",TTT) F TTT=0:0 S TTT=$O(^TMP($J,"PSSO",TTT)) Q:'TTT I ORDNAM'=^TMP($J,"PSSO",TTT) S PSCOMMD=1
- .I $O(^TMP($J,"PSSO",0)),'PSCOMMD K ^TMP("PSSD",$J,"ZZZZ",PSNAME) Q
- .S CNT=0 I $O(^TMP($J,"PSSO",0)),'$D(^TMP("PSSD",$J,"ZZZZ",PSNAME)) S (CNT,TMPFLG)=1 F NN=0:0 S NN=$O(^TMP($J,"PSSO",NN)) Q:'NN S ^TMP("PSSD",$J,"ZZZZ",PSNAME,CNT)=^TMP($J,"PSSO",NN) S CNT=CNT+1
- .I CNT S RSN="Multiple Orderable Items" Q
- .S QFLAG=0 I +$P(PSNDO,"^"),+$P(PSNDO,"^",3) S DA=$P($G(PSNDO),"^"),X=$$VAGN^PSNAPIS(DA),VAGN1=X I VAGN1'=0 S DOSFO=$P(FRM1,"^") D
- ..I DOSFO,$D(^PS(50.606,DOSFO,0)),$L(VAGN1)<41 S QFLAG=1
- .I QFLAG K ^TMP("PSSD",$J,"ZZZZ",PSNAME) Q
- .I $D(^TMP("PSSD",$J,"ZZZZ",PSNAME)) Q
- .S TMPFLG=1
- .I $P(PSNDO,"^")="" S RSN="NDF link missing or incomplete" Q
- .I $P(PSNDO,"^",3)="" S RSN="No PSNDF VA Product Name Entry" Q
- .I VAGN1=0 S RSN="Invalid National Drug File Entry" Q
- .S PVA=$P($G(PSNDO),"^",3),DA=$P($G(PSNDO),"^"),K=PVA,X=$$PROD0^PSNAPIS(DA,K) I X']"" S RSN="Invalid PSNDF VA Product Name Entry" Q
- .S DA=$P($G(PSNDO),"^"),K=PVA,X=$$PSJDF^PSNAPIS(DA,K),FRM0=X I FRM0=0 S RSN="No Dosage Form entry in NDF" Q
- .I FRM0=0 S RSN="Missing Dosage Form in NDF" Q
- .I FRM0=0 S RSN="Invalid Entry in Dosage Form File" Q
- .I $L(VAGN1)>40 S RSN="Generic name exceeds 40 characters" Q
- .S RSN="Undetermined problem" Q
- DONE K ^TMP($J,"PSSO"),^TMP("PSS",$J),APL,BB,CNT,DOSFRM,DOSPNT,SAME,LLL,III,NN,ORDNAM,OTHER,OTNO,POINAME,PSCOMMD,PSNAME,PSPTR,PSPRIM,POTDOS,PSNDO,DOSFO,PVA,QFLAG,RSN,TTT,TMPFLG Q
- PSSPOIC ;BIR/RTR-Orderable items by VA Name after Primary ; 09/01/98 7:10
- +1 ;;1.0;PHARMACY DATA MANAGEMENT;**15**;9/30/97
- +2 IF '$GET(PSMATCH)
- GOTO CANT
- +3 ;VA Generic Name after Primary checks that can auto-match
- BEG FOR PPP=0:0
- SET PPP=$ORDER(^PSDRUG(PPP))
- IF 'PPP
- QUIT
- Begin DoDot:1
- +1 SET NDNOD=$GET(^PSDRUG(PPP,"ND"))
- SET PSODNAME=$PIECE($GET(^(0)),"^")
- SET PRIPTR=$PIECE($GET(^(2)),"^",6)
- SET PSOIPTR=$PIECE($GET(^(2)),"^")
- SET DA=$PIECE($GET(PSNDO),"^")
- SET K=$PIECE($GET(PSNDO),"^",3)
- SET X=$$PSJDF^PSNAPIS(DA,K)
- SET DOFO=X
- +2 IF PSODNAME=""
- QUIT
- +3 IF $DATA(^TMP("PSS",$JOB,PSODNAME))
- QUIT
- +4 IF +PSOIPTR
- QUIT
- +5 KILL ^TMP($JOB,"PSSPP")
- IF +$PIECE(NDNOD,"^")
- IF +$PIECE(NDNOD,"^",3)
- FOR AA=0:0
- SET AA=$ORDER(^PSDRUG("AND",+NDNOD,AA))
- IF 'AA
- QUIT
- SET OTHNAME=$PIECE($GET(^PSDRUG(AA,0)),"^")
- IF $DATA(^TMP("PSS",$JOB,OTHNAME))
- Begin DoDot:2
- +6 SET ONOD=$GET(^PSDRUG(AA,"ND"))
- IF +$PIECE(ONOD,"^")
- IF +$PIECE(ONOD,"^",3)
- IF DOFO'=0
- SET DA=$PIECE($GET(ONOD),"^")
- SET K=$PIECE($GET(ONOD),"^",3)
- SET X=$$PSJDF^PSNAPIS(DA,K)
- SET DOFO1=X
- IF DOFO1'=0
- Begin DoDot:3
- +7 IF DOFO=DOFO1
- SET ^TMP($JOB,"PSSPP",AA)=^TMP("PSS",$JOB,OTHNAME)
- End DoDot:3
- End DoDot:2
- +8 SET (COMM,COMMSUP)=0
- IF $ORDER(^TMP($JOB,"PSSPP",0))
- SET COMM=1
- SET WW=$ORDER(^TMP($JOB,"PSSPP",0))
- SET POII=^TMP($JOB,"PSSPP",WW)
- FOR WW=0:0
- SET WW=$ORDER(^TMP($JOB,"PSSPP",WW))
- IF 'WW
- QUIT
- IF POII'=^TMP($JOB,"PSSPP",WW)
- SET COMMSUP=1
- +9 IF COMM
- IF COMMSUP
- QUIT
- +10 IF COMM
- IF 'COMMSUP
- SET ZZZ=$ORDER(^TMP($JOB,"PSSPP",0))
- SET ZZZ=^TMP($JOB,"PSSPP",ZZZ)
- SET ^TMP("PSSD",$JOB,ZZZ,PSODNAME)=""
- QUIT
- +11 IF +$PIECE(NDNOD,"^")
- IF +$PIECE(NDNOD,"^",3)
- SET DA=$PIECE($GET(NDNOD),"^")
- SET K=$PIECE($GET(NDNOD),"^",3)
- SET X=$$PSJDF^PSNAPIS(DA,K)
- SET D1F1=X
- IF D1F1'=0
- Begin DoDot:2
- +12 SET DA=$PIECE($GET(NDNOD),"^")
- SET X=$$VAGN^PSNAPIS(DA)
- SET VAGN=X
- IF $LENGTH(VAGN)<41
- Begin DoDot:3
- +13 SET ^TMP("PSSD",$JOB,VAGN_" "_$PIECE(D1F1,"^",2),PSODNAME)=""
- End DoDot:3
- End DoDot:2
- End DoDot:1
- END KILL ^TMP($JOB,"PSSPP"),AA,APPU,COMM,COMMSUP,NDNOD,ONOD,OTHNAME,POII,PPP,PSOIPTR,PRIPTR,PSODF,PSODNAME,WW,ZZZ
- QUIT
- CANT ;Generic Name after Primary, can't match
- +1 FOR LLL=0:0
- SET LLL=$ORDER(^PSDRUG(LLL))
- IF 'LLL
- QUIT
- Begin DoDot:1
- +2 KILL RSN,DOSFO,POTDOS
- +3 SET PSNDO=$GET(^PSDRUG(LLL,"ND"))
- SET PSNAME=$PIECE($GET(^(0)),"^")
- SET PSPTR=$PIECE($GET(^(2)),"^")
- SET PSPRIM=$PIECE($GET(^(2)),"^",6)
- SET DA=$PIECE($GET(PSNDO),"^")
- SET K=$PIECE($GET(PSNDO),"^",3)
- SET X=$$PSJDF^PSNAPIS(DA,K)
- SET FRM1=X
- SET TMPFLG=0
- +4 IF +PSPTR
- QUIT
- +5 ;If Primary, ZZZZ or PSS
- +6 IF $DATA(^TMP("PSS",$JOB,PSNAME))
- QUIT
- +7 KILL ^TMP($JOB,"PSSO")
- IF +$PIECE(PSNDO,"^")
- IF +$PIECE(PSNDO,"^",3)
- FOR BB=0:0
- SET BB=$ORDER(^PSDRUG("AND",+PSNDO,BB))
- IF 'BB
- QUIT
- SET OTHER=$PIECE($GET(^PSDRUG(BB,0)),"^")
- IF $DATA(^TMP("PSS",$JOB,OTHER))
- Begin DoDot:2
- +8 SET OTNO=$GET(^PSDRUG(BB,"ND"))
- IF +$PIECE(OTNO,"^")
- IF +$PIECE(OTNO,"^",3)
- IF FRM1'=0
- SET DA=$PIECE($GET(OTNO),"^")
- SET K=$PIECE($GET(OTNO),"^",3)
- SET X=$$PSJDF^PSNAPIS(DA,K)
- SET FRM2=X
- IF FRM2'=0
- Begin DoDot:3
- +9 IF FRM1=FRM2
- Begin DoDot:4
- +10 SET SAME=0
- SET POINAME=^TMP("PSS",$JOB,OTHER)
- FOR III=0:0
- SET III=$ORDER(^TMP($JOB,"PSSO",III))
- IF 'III
- QUIT
- IF POINAME=^(III)
- SET SAME=1
- +11 IF 'SAME
- SET ^TMP($JOB,"PSSO",BB)=^TMP("PSS",$JOB,OTHER)
- End DoDot:4
- End DoDot:3
- End DoDot:2
- +12 SET PSCOMMD=0
- IF $ORDER(^TMP($JOB,"PSSO",0))
- SET TTT=$ORDER(^TMP($JOB,"PSSO",0))
- SET ORDNAM=^TMP($JOB,"PSSO",TTT)
- FOR TTT=0:0
- SET TTT=$ORDER(^TMP($JOB,"PSSO",TTT))
- IF 'TTT
- QUIT
- IF ORDNAM'=^TMP($JOB,"PSSO",TTT)
- SET PSCOMMD=1
- +13 IF $ORDER(^TMP($JOB,"PSSO",0))
- IF 'PSCOMMD
- KILL ^TMP("PSSD",$JOB,"ZZZZ",PSNAME)
- QUIT
- +14 SET CNT=0
- IF $ORDER(^TMP($JOB,"PSSO",0))
- IF '$DATA(^TMP("PSSD",$JOB,"ZZZZ",PSNAME))
- SET (CNT,TMPFLG)=1
- FOR NN=0:0
- SET NN=$ORDER(^TMP($JOB,"PSSO",NN))
- IF 'NN
- QUIT
- SET ^TMP("PSSD",$JOB,"ZZZZ",PSNAME,CNT)=^TMP($JOB,"PSSO",NN)
- SET CNT=CNT+1
- +15 IF CNT
- SET RSN="Multiple Orderable Items"
- QUIT
- +16 SET QFLAG=0
- IF +$PIECE(PSNDO,"^")
- IF +$PIECE(PSNDO,"^",3)
- SET DA=$PIECE($GET(PSNDO),"^")
- SET X=$$VAGN^PSNAPIS(DA)
- SET VAGN1=X
- IF VAGN1'=0
- SET DOSFO=$PIECE(FRM1,"^")
- Begin DoDot:2
- +17 IF DOSFO
- IF $DATA(^PS(50.606,DOSFO,0))
- IF $LENGTH(VAGN1)<41
- SET QFLAG=1
- End DoDot:2
- +18 IF QFLAG
- KILL ^TMP("PSSD",$JOB,"ZZZZ",PSNAME)
- QUIT
- +19 IF $DATA(^TMP("PSSD",$JOB,"ZZZZ",PSNAME))
- QUIT
- +20 SET TMPFLG=1
- +21 IF $PIECE(PSNDO,"^")=""
- SET RSN="NDF link missing or incomplete"
- QUIT
- +22 IF $PIECE(PSNDO,"^",3)=""
- SET RSN="No PSNDF VA Product Name Entry"
- QUIT
- +23 IF VAGN1=0
- SET RSN="Invalid National Drug File Entry"
- QUIT
- +24 SET PVA=$PIECE($GET(PSNDO),"^",3)
- SET DA=$PIECE($GET(PSNDO),"^")
- SET K=PVA
- SET X=$$PROD0^PSNAPIS(DA,K)
- IF X']""
- SET RSN="Invalid PSNDF VA Product Name Entry"
- QUIT
- +25 SET DA=$PIECE($GET(PSNDO),"^")
- SET K=PVA
- SET X=$$PSJDF^PSNAPIS(DA,K)
- SET FRM0=X
- IF FRM0=0
- SET RSN="No Dosage Form entry in NDF"
- QUIT
- +26 IF FRM0=0
- SET RSN="Missing Dosage Form in NDF"
- QUIT
- +27 IF FRM0=0
- SET RSN="Invalid Entry in Dosage Form File"
- QUIT
- +28 IF $LENGTH(VAGN1)>40
- SET RSN="Generic name exceeds 40 characters"
- QUIT
- +29 SET RSN="Undetermined problem"
- QUIT
- End DoDot:1
- IF TMPFLG
- SET ^TMP("PSSD",$JOB,"ZZZZ",PSNAME)=RSN
- DONE KILL ^TMP($JOB,"PSSO"),^TMP("PSS",$JOB),APL,BB,CNT,DOSFRM,DOSPNT,SAME,LLL,III,NN,ORDNAM,OTHER,OTNO,POINAME,PSCOMMD,PSNAME,PSPTR,PSPRIM,POTDOS,PSNDO,DOSFO,PVA,QFLAG,RSN,TTT,TMPFLG
- QUIT
