PSNHIT ;BIR/CCH&WRT-After match is made package size and type selected ; 02/08/00 8:41
 ;;4.0; NATIONAL DRUG FILE;**22,47,65**; 30 Oct 98
 ;
 ;Reference to ^DIC(51.5 supported by DBIA #1931
 ;Reference to ^PSDRUG supported by DBIA #2352,#221
 ;
 S ASC="Enter your choice or press return to continue: "
HIT W !!,"Match made with ",PSNLOC W:$P(^PSDRUG(PSNB,0),"^",9)=1 ?62,"N/F" W !,"  Now select VA Product Name ",! ; I PSNTRFL S ZZXX=$P(^PSNDF(50.67,+Y,0),"^",6) S (PSNDA,DA)=$P(^PSNDF(50.68,ZZXX,0),"^",2)
 S PSNFL=0 ; S PSNDA=+Y S DA=PSNDA,X=$$VAP^PSNAPIS(DA,.LIST) I X=1 S IEN=0,IEN=$O(LIST(IEN)) Q:'IEN  W $P(LIST(IEN),"^",2) S PSNFNM=IEN G RESP
FORM K ANS,LIST,DA S DA=PSNDA,X=$$VAP^PSNAPIS(DA,.LIST),STOP=X D STAR0,STAR F PSNWR=0:0 S PSNWR=$O(^TMP($J,"PSNND",PSNWR)) Q:'PSNWR
WRTIT F BB=1:1:STOP D EXTD D  I BB#10=0,STOP'=10 W !!,ASC R ANS:DTIME S:'$T ANS="^" S:ANS="^" PSNFL=1 Q:PSNFL  Q:ANS]""
 .W !,BB," ",$P(^TMP($J,"PSNND",BB),"^",1)_"    "_$P(^TMP($J,"PSNND",BB),"^",3)_"  "_$P(^TMP($J,"PSNND",BB),"^",4)_"  "_CMID_"  "_$S($P(^TMP($J,"PSNND",BB),"^",6)="I":"**INACTIVE**",1:"")
 I $D(ANS),ANS?.E1C.E G FORM
 I $D(ANS),ANS["?" D HIT1^PSNHELP K ANS G FORM
 Q:PSNFL  I $D(ANS),ANS']"" K ANS
 I $D(ANS),ANS?.E1C.E G FORM
VAPN I '$D(ANS) S:$D(XRT0) XRTN=$T(+0) D:$D(XRT0) T1^%ZOSV R !!,"Enter your choice: ",ANS:DTIME S:'$T ANS="^" S:ANS["^" PSNFL=1 Q:PSNFL
 I ANS?.E1C.E K ANS G VAPN
 I $D(ANS),ANS["?" D NDC3^PSNHELP W !!,"Match local drug  ",PSNNAM," with " W !,?40,"ORDER UNIT: " I $D(PSNODE),$D(PSNOU),$D(^DIC(51.5)) W ?52,$S('$D(^DIC(51.5,PSNOU)):"",1:$P(^DIC(51.5,PSNOU,0),"^",1))
 I $D(ANS),ANS["?" K ANS W !,?24,"DISPENSE UNITS/ORDER UNITS: ",$S('$D(PSNODE):"",1:$P(PSNODE,"^",5)),!,?37,"DISPENSE UNIT: ",$S('$D(PSNODE):"",1:$P(PSNODE,"^",8)),!,?5 G FORM
 I $D(ANS),ANS']"" G TRY3^PSNCOMP
 I $D(ANS),'$D(^TMP($J,"PSNND",ANS)) W !!,"Invalid answer",! K ANS G FORM
 S (PSNFNM,KK)=$P(^TMP($J,"PSNND",ANS),"^",2)
RESP R !,?10,"Is this a match  < Reply Y, N or press return to continue > :  ",ANS:DTIME S:'$T ANS="^" W ! I ANS']"" K ANS,PSNFORM G PUNT^PSNCOMP
 I ANS?.E1C.E G RESP
 I "Nn"[$E(ANS),'X K ANS,PSNFORM G PUNT^PSNCOMP
 I "Nn"[$E(ANS) K ANS,PSNFORM G FORM
 I ANS["^" S PSNFL=1 Q
 I ANS["?" D RES1^PSNHELP K ANS G RESP
 I "YyNn"'[$E(ANS) W !," Invalid Response " G RESP
 I $P(LIST(KK),"^",7)="I" W !,"Inactive VA Product entry has been selected!!",!! G FORM
 S PSNCLASS=$P(^PSNDF(50.68,PSNFNM,3),"^"),PSNNDF=PSNDA S PSNVAR="BLDIT^PSNCOMP" D ^PSNSTCK I $D(PSNFL) Q:PSNFL
 Q:'$D(ANS)  I "NOno"[ANS K ANS Q
SET S:'$D(^PSNTRAN(PSNB,0)) $P(^PSNTRAN(0),"^",4)=($P(^PSNTRAN(0),"^",4))+1,$P(^PSNTRAN(0),"^",3)=PSNB
 S ^PSNTRAN(PSNB,0)=PSNNDF_"^"_PSNFNM_"^"_PSNCLASS_"^^"_PSNSIZE_"^^"_PSNTYPE_"^"_DUZ D PKI W:$D(IOF) @IOF S:'$D(PSNFL) PSNFL=0 Q
PRA ; PRINT DOSE FORM AND CLASS AFTER VA PRODUCT NAME IF A DUPLICATE
 ; S PSNDFM=$P(^PSNDF(PSNDA,2,$P(^PSNDF(PSNDA,5,KK,0),"^",2),0),"^",1),PSND=$P(^PS(50.606,PSNDFM,0),"^",1)
 ; S PSNVCL=$P(^PSNDF(PSNDA,2,$P(^PSNDF(PSNDA,5,KK,0),"^",2),0),"^",3),PSNVC=$P(^PS(50.605,PSNVCL,0),"^",1) W "     ",PSND,"  ",PSNVC S PSNF=0 Q
 ; W "     ",PSND,"  ",PSNVC S PSNF=0 Q
 Q
OOPS W !!,"No match found" S ^PSNTRAN(PSNB,0)="0^^^^^^^"_DUZ Q
 Q
 Q
STAR K ^TMP($J,"PSNND") S PSNRAN=0 S PSNM="" F WRT=0:0 S PSNM=$O(^TMP($J,"PSNDF1",PSNM)) Q:PSNM=""  D SETARY1
 Q
SETARY1 S CID=" " F KK=0:0 S KK=$O(^TMP($J,"PSNDF1",PSNM,KK)) Q:'KK  S CID=$P($G(^PSNDF(50.68,KK,1)),"^",2) D ARRAY
 Q
ARRAY S PSNRAN=PSNRAN+1 S ^TMP($J,"PSNND",PSNRAN)=PSNM_"^"_KK_"^"_$P(LIST(KK),"^",4)_"^"_$P(LIST(KK),"^",6)_"^"_CID_"^"_$P(LIST(KK),"^",7)
 Q
KILL K ANS,IFN,PSNDA,PSNDDA,PSNUNDA,PSNSTDA,DIC,II,MJL,JJ,NBR,PSNCLASS,PSNFL,PSNFNM,PSNFORM,PSNNAM,PSNNAME,DOS,NDP,PS,PT,STR,UNT,VV,VV1,PSNNDC,PSNNDF,PSNSP,PSNSIZE,PSNTYPE,PSNVAR,PSNSZ,PSNTRFL,PSNTYP,X,Y,PSNSZE
 K PSNTPE,PSNODE,PSNOU,VADC,PSNLOC,^TMP($J,"PSNND"),ASC,PSNRAN,PSNV,PSNWR,PSNX,PSNZ,WRT,BB,END,LIST,IEN,^TMP($J,"PSNDF1") Q
STAR0 K ^TMP($J,"PSNDF1") F IEN=0:0 S IEN=$O(LIST(IEN)) Q:'IEN  S ^TMP($J,"PSNDF1",$P(LIST(IEN),"^",2),IEN)=""
 Q
ASKIT D PKSIZE^PSNOUT,PKTYPE^PSNOUT W !!,"Local drug ",$P(^PSDRUG(PSNB,0),"^"),!,"matches ",?11,PSNFORM,!,"PACKAGE SIZE: ",PSNSZE,!,"PACKAGE TYPE: ",PSNTPE
 W !?10,"Is this a match ?" K DIR S DIR("B")="YES",DIR(0)="Y" D ^DIR Q:$D(DIRUT)
 I Y(0)="NO" Q
 I Y(0)="YES" D SET^PSNHIT
 Q
ASKIT1 S DUNCE=0 D PKSIZE^PSNOUT,PKTYPE^PSNOUT W !!,"Local drug ",$P(^PSDRUG(PSNB,0),"^"),!,"matches ",?11,PSNFORM,!,"PACKAGE SIZE: ",PSNSZE,!,"PACKAGE TYPE: ",PSNTPE
 W !?10,"Is this a match ?" K DIR S DIR("B")="YES",DIR(0)="Y" D ^DIR Q:$D(DIRUT)
 I Y(0)="NO" S DUNCE=1,NOMSYN=1
 I Y(0)="YES" D SET^PSNHIT
 Q
EXTD S CMID=$P(^TMP($J,"PSNND",BB),"^",5)
 Q
PKI N CS
 I +$P($G(^PSNDF(50.68,PSNFNM,7)),"^") S CS=$P(^(7),"^") D
 .S CS=$S(CS?1(1"2n",1"3n"):+CS_"C",+CS=2!(+CS=3)&(CS'["C"):+CS_"A",1:CS)
 .I $L(CS)=1,$P(^PSDRUG(PSNB,0),"^",3)[CS Q
 .I $P(^PSDRUG(PSNB,0),"^",3)[$E(CS),$P(^PSDRUG(PSNB,0),"^",3)[$E(CS,2) Q
 .W !!,"The CS Federal Schedule associated with this drug in the VA Product file"
 .W !,"represents a DEA, Special Handling code of "_CS,!!
 .W ?5,"Enter RETURN to continue..." R X:10
 Q