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,492,396**; 30 Oct 98;Build 190
;
;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 ",!
S PSNFL=0
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:"")
.W " "_$$GET1^DIQ(50.68,$P(^TMP($J,"PSNND",BB),"^",2),109) ;PPSN
.W " "_$P(^TMP($J,"PSNND",BB),"^",7) ; PSN*4*492 FMCT
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)_"^"_$S($P(LIST(KK),"^",8)="Tier ":"",1:$P(LIST(KK),"^",8))
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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSNHIT 5150 printed Apr 09, 2024@21:19:35 Page 2
PSNHIT ;BIR/CCH&WRT-After match is made package size and type selected ; 02/08/00 8:41
+1 ;;4.0;NATIONAL DRUG FILE;**22,47,65,492,396**; 30 Oct 98;Build 190
+2 ;
+3 ;Reference to ^DIC(51.5 supported by DBIA #1931
+4 ;Reference to ^PSDRUG supported by DBIA #2352,#221
+5 ;
+6 SET ASC="Enter your choice or press return to continue: "
HIT WRITE !!,"Match made with ",PSNLOC
if $PIECE(^PSDRUG(PSNB,0),"^",9)=1
WRITE ?62,"N/F"
WRITE !," Now select VA Product Name ",!
+1 SET PSNFL=0
FORM KILL ANS,LIST,DA
SET DA=PSNDA
SET X=$$VAP^PSNAPIS(DA,.LIST)
SET STOP=X
DO STAR0
DO STAR
FOR PSNWR=0:0
SET PSNWR=$ORDER(^TMP($JOB,"PSNND",PSNWR))
if 'PSNWR
QUIT
WRTIT FOR BB=1:1:STOP
DO EXTD
Begin DoDot:1
+1 WRITE !,BB," ",$PIECE(^TMP($JOB,"PSNND",BB),"^",1)_" "_$PIECE(^TMP($JOB,"PSNND",BB),"^",3)_" "_$PIECE(^TMP($JOB,"PSNND",BB),"^",4)_" "_CMID_" "_$SELECT($PIECE(^TMP($JOB,"PSNND",BB),"^",6)="I":"**INACTIVE**",1:"")
+2 ;PPSN
WRITE " "_$$GET1^DIQ(50.68,$PIECE(^TMP($JOB,"PSNND",BB),"^",2),109)
+3 ; PSN*4*492 FMCT
WRITE " "_$PIECE(^TMP($JOB,"PSNND",BB),"^",7)
End DoDot:1
IF BB#10=0
IF STOP'=10
WRITE !!,ASC
READ ANS:DTIME
if '$TEST
SET ANS="^"
if ANS="^"
SET PSNFL=1
if PSNFL
QUIT
if ANS]""
QUIT
+4 IF $DATA(ANS)
IF ANS?.E1C.E
GOTO FORM
+5 IF $DATA(ANS)
IF ANS["?"
DO HIT1^PSNHELP
KILL ANS
GOTO FORM
+6 if PSNFL
QUIT
IF $DATA(ANS)
IF ANS']""
KILL ANS
+7 IF $DATA(ANS)
IF ANS?.E1C.E
GOTO FORM
VAPN IF '$DATA(ANS)
if $DATA(XRT0)
SET XRTN=$TEXT(+0)
if $DATA(XRT0)
DO T1^%ZOSV
READ !!,"Enter your choice: ",ANS:DTIME
if '$TEST
SET ANS="^"
if ANS["^"
SET PSNFL=1
if PSNFL
QUIT
+1 IF ANS?.E1C.E
KILL ANS
GOTO VAPN
+2 IF $DATA(ANS)
IF ANS["?"
DO NDC3^PSNHELP
WRITE !!,"Match local drug ",PSNNAM," with "
WRITE !,?40,"ORDER UNIT: "
IF $DATA(PSNODE)
IF $DATA(PSNOU)
IF $DATA(^DIC(51.5))
WRITE ?52,$SELECT('$DATA(^DIC(51.5,PSNOU)):"",1:$PIECE(^DIC(51.5,PSNOU,0),"^",1))
+3 IF $DATA(ANS)
IF ANS["?"
KILL ANS
WRITE !,?24,"DISPENSE UNITS/ORDER UNITS: ",$SELECT('$DATA(PSNODE):"",1:$PIECE(PSNODE,"^",5)),!,?37,"DISPENSE UNIT: ",$SELECT('$DATA(PSNODE):"",1:$PIECE(PSNODE,"^",8)),!,?5
GOTO FORM
+4 IF $DATA(ANS)
IF ANS']""
GOTO TRY3^PSNCOMP
+5 IF $DATA(ANS)
IF '$DATA(^TMP($JOB,"PSNND",ANS))
WRITE !!,"Invalid answer",!
KILL ANS
GOTO FORM
+6 SET (PSNFNM,KK)=$PIECE(^TMP($JOB,"PSNND",ANS),"^",2)
RESP READ !,?10,"Is this a match < Reply Y, N or press return to continue > : ",ANS:DTIME
if '$TEST
SET ANS="^"
WRITE !
IF ANS']""
KILL ANS,PSNFORM
GOTO PUNT^PSNCOMP
+1 IF ANS?.E1C.E
GOTO RESP
+2 IF "Nn"[$EXTRACT(ANS)
IF 'X
KILL ANS,PSNFORM
GOTO PUNT^PSNCOMP
+3 IF "Nn"[$EXTRACT(ANS)
KILL ANS,PSNFORM
GOTO FORM
+4 IF ANS["^"
SET PSNFL=1
QUIT
+5 IF ANS["?"
DO RES1^PSNHELP
KILL ANS
GOTO RESP
+6 IF "YyNn"'[$EXTRACT(ANS)
WRITE !," Invalid Response "
GOTO RESP
+7 IF $PIECE(LIST(KK),"^",7)="I"
WRITE !,"Inactive VA Product entry has been selected!!",!!
GOTO FORM
+8 SET PSNCLASS=$PIECE(^PSNDF(50.68,PSNFNM,3),"^")
SET PSNNDF=PSNDA
SET PSNVAR="BLDIT^PSNCOMP"
DO ^PSNSTCK
IF $DATA(PSNFL)
if PSNFL
QUIT
+9 if '$DATA(ANS)
QUIT
IF "NOno"[ANS
KILL ANS
QUIT
SET if '$DATA(^PSNTRAN(PSNB,0))
SET $PIECE(^PSNTRAN(0),"^",4)=($PIECE(^PSNTRAN(0),"^",4))+1
SET $PIECE(^PSNTRAN(0),"^",3)=PSNB
+1 SET ^PSNTRAN(PSNB,0)=PSNNDF_"^"_PSNFNM_"^"_PSNCLASS_"^^"_PSNSIZE_"^^"_PSNTYPE_"^"_DUZ
DO PKI
if $DATA(IOF)
WRITE @IOF
if '$DATA(PSNFL)
SET PSNFL=0
QUIT
PRA ; PRINT DOSE FORM AND CLASS AFTER VA PRODUCT NAME IF A DUPLICATE
+1 ; S PSNDFM=$P(^PSNDF(PSNDA,2,$P(^PSNDF(PSNDA,5,KK,0),"^",2),0),"^",1),PSND=$P(^PS(50.606,PSNDFM,0),"^",1)
+2 ; 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
+3 ; W " ",PSND," ",PSNVC S PSNF=0 Q
+4 QUIT
OOPS WRITE !!,"No match found"
SET ^PSNTRAN(PSNB,0)="0^^^^^^^"_DUZ
QUIT
+1 QUIT
+2 QUIT
STAR KILL ^TMP($JOB,"PSNND")
SET PSNRAN=0
SET PSNM=""
FOR WRT=0:0
SET PSNM=$ORDER(^TMP($JOB,"PSNDF1",PSNM))
if PSNM=""
QUIT
DO SETARY1
+1 QUIT
SETARY1 SET CID=" "
FOR KK=0:0
SET KK=$ORDER(^TMP($JOB,"PSNDF1",PSNM,KK))
if 'KK
QUIT
SET CID=$PIECE($GET(^PSNDF(50.68,KK,1)),"^",2)
DO ARRAY
+1 QUIT
ARRAY SET PSNRAN=PSNRAN+1
SET ^TMP($JOB,"PSNND",PSNRAN)=PSNM_"^"_KK_"^"_$PIECE(LIST(KK),"^",4)_"^"_$PIECE(LIST(KK),"^",6)_"^"_CID_"^"_$PIECE(LIST(KK),"^",7)_"^"_$SELECT($PIECE(LIST(KK),"^",8)="Tier ":"",1:$PIECE(LIST(KK),"^",8))
+1 QUIT
KILL KILL 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
+1 KILL PSNTPE,PSNODE,PSNOU,VADC,PSNLOC,^TMP($JOB,"PSNND"),ASC,PSNRAN,PSNV,PSNWR,PSNX,PSNZ,WRT,BB,END,LIST,IEN,^TMP($JOB,"PSNDF1")
QUIT
STAR0 KILL ^TMP($JOB,"PSNDF1")
FOR IEN=0:0
SET IEN=$ORDER(LIST(IEN))
if 'IEN
QUIT
SET ^TMP($JOB,"PSNDF1",$PIECE(LIST(IEN),"^",2),IEN)=""
+1 QUIT
ASKIT DO PKSIZE^PSNOUT
DO PKTYPE^PSNOUT
WRITE !!,"Local drug ",$PIECE(^PSDRUG(PSNB,0),"^"),!,"matches ",?11,PSNFORM,!,"PACKAGE SIZE: ",PSNSZE,!,"PACKAGE TYPE: ",PSNTPE
+1 WRITE !?10,"Is this a match ?"
KILL DIR
SET DIR("B")="YES"
SET DIR(0)="Y"
DO ^DIR
if $DATA(DIRUT)
QUIT
+2 IF Y(0)="NO"
QUIT
+3 IF Y(0)="YES"
DO SET^PSNHIT
+4 QUIT
ASKIT1 SET DUNCE=0
DO PKSIZE^PSNOUT
DO PKTYPE^PSNOUT
WRITE !!,"Local drug ",$PIECE(^PSDRUG(PSNB,0),"^"),!,"matches ",?11,PSNFORM,!,"PACKAGE SIZE: ",PSNSZE,!,"PACKAGE TYPE: ",PSNTPE
+1 WRITE !?10,"Is this a match ?"
KILL DIR
SET DIR("B")="YES"
SET DIR(0)="Y"
DO ^DIR
if $DATA(DIRUT)
QUIT
+2 IF Y(0)="NO"
SET DUNCE=1
SET NOMSYN=1
+3 IF Y(0)="YES"
DO SET^PSNHIT
+4 QUIT
EXTD SET CMID=$PIECE(^TMP($JOB,"PSNND",BB),"^",5)
+1 QUIT
PKI NEW CS
+1 IF +$PIECE($GET(^PSNDF(50.68,PSNFNM,7)),"^")
SET CS=$PIECE(^(7),"^")
Begin DoDot:1
+2 SET CS=$SELECT(CS?1(1"2n",1"3n"):+CS_"C",+CS=2!(+CS=3)&(CS'["C"):+CS_"A",1:CS)
+3 IF $LENGTH(CS)=1
IF $PIECE(^PSDRUG(PSNB,0),"^",3)[CS
QUIT
+4 IF $PIECE(^PSDRUG(PSNB,0),"^",3)[$EXTRACT(CS)
IF $PIECE(^PSDRUG(PSNB,0),"^",3)[$EXTRACT(CS,2)
QUIT
+5 WRITE !!,"The CS Federal Schedule associated with this drug in the VA Product file"
+6 WRITE !,"represents a DEA, Special Handling code of "_CS,!!
+7 WRITE ?5,"Enter RETURN to continue..."
READ X:10
End DoDot:1
+8 QUIT
