source: WorldVistAEHR/trunk/r/NATIONAL_DRUG_FILE-PSN/PSNHIT.m@ 1800

Last change on this file since 1800 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 5.0 KB
RevLine 
[613]1PSNHIT ;BIR/CCH&WRT-After match is made package size and type selected ; 02/08/00 8:41
2 ;;4.0; NATIONAL DRUG FILE;**22,47,65**; 30 Oct 98
3 ;
4 ;Reference to ^DIC(51.5 supported by DBIA #1931
5 ;Reference to ^PSDRUG supported by DBIA #2352,#221
6 ;
7 S ASC="Enter your choice or press return to continue: "
8HIT 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)
9 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
10FORM 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
11WRTIT 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]""
12 .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:"")
13 I $D(ANS),ANS?.E1C.E G FORM
14 I $D(ANS),ANS["?" D HIT1^PSNHELP K ANS G FORM
15 Q:PSNFL I $D(ANS),ANS']"" K ANS
16 I $D(ANS),ANS?.E1C.E G FORM
17VAPN 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
18 I ANS?.E1C.E K ANS G VAPN
19 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))
20 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
21 I $D(ANS),ANS']"" G TRY3^PSNCOMP
22 I $D(ANS),'$D(^TMP($J,"PSNND",ANS)) W !!,"Invalid answer",! K ANS G FORM
23 S (PSNFNM,KK)=$P(^TMP($J,"PSNND",ANS),"^",2)
24RESP 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
25 I ANS?.E1C.E G RESP
26 I "Nn"[$E(ANS),'X K ANS,PSNFORM G PUNT^PSNCOMP
27 I "Nn"[$E(ANS) K ANS,PSNFORM G FORM
28 I ANS["^" S PSNFL=1 Q
29 I ANS["?" D RES1^PSNHELP K ANS G RESP
30 I "YyNn"'[$E(ANS) W !," Invalid Response " G RESP
31 I $P(LIST(KK),"^",7)="I" W !,"Inactive VA Product entry has been selected!!",!! G FORM
32 S PSNCLASS=$P(^PSNDF(50.68,PSNFNM,3),"^"),PSNNDF=PSNDA S PSNVAR="BLDIT^PSNCOMP" D ^PSNSTCK I $D(PSNFL) Q:PSNFL
33 Q:'$D(ANS) I "NOno"[ANS K ANS Q
34SET S:'$D(^PSNTRAN(PSNB,0)) $P(^PSNTRAN(0),"^",4)=($P(^PSNTRAN(0),"^",4))+1,$P(^PSNTRAN(0),"^",3)=PSNB
35 S ^PSNTRAN(PSNB,0)=PSNNDF_"^"_PSNFNM_"^"_PSNCLASS_"^^"_PSNSIZE_"^^"_PSNTYPE_"^"_DUZ D PKI W:$D(IOF) @IOF S:'$D(PSNFL) PSNFL=0 Q
36PRA ; PRINT DOSE FORM AND CLASS AFTER VA PRODUCT NAME IF A DUPLICATE
37 ; S PSNDFM=$P(^PSNDF(PSNDA,2,$P(^PSNDF(PSNDA,5,KK,0),"^",2),0),"^",1),PSND=$P(^PS(50.606,PSNDFM,0),"^",1)
38 ; 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
39 ; W " ",PSND," ",PSNVC S PSNF=0 Q
40 Q
41OOPS W !!,"No match found" S ^PSNTRAN(PSNB,0)="0^^^^^^^"_DUZ Q
42 Q
43 Q
44STAR K ^TMP($J,"PSNND") S PSNRAN=0 S PSNM="" F WRT=0:0 S PSNM=$O(^TMP($J,"PSNDF1",PSNM)) Q:PSNM="" D SETARY1
45 Q
46SETARY1 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
47 Q
48ARRAY S PSNRAN=PSNRAN+1 S ^TMP($J,"PSNND",PSNRAN)=PSNM_"^"_KK_"^"_$P(LIST(KK),"^",4)_"^"_$P(LIST(KK),"^",6)_"^"_CID_"^"_$P(LIST(KK),"^",7)
49 Q
50KILL 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
51 K PSNTPE,PSNODE,PSNOU,VADC,PSNLOC,^TMP($J,"PSNND"),ASC,PSNRAN,PSNV,PSNWR,PSNX,PSNZ,WRT,BB,END,LIST,IEN,^TMP($J,"PSNDF1") Q
52STAR0 K ^TMP($J,"PSNDF1") F IEN=0:0 S IEN=$O(LIST(IEN)) Q:'IEN S ^TMP($J,"PSNDF1",$P(LIST(IEN),"^",2),IEN)=""
53 Q
54ASKIT D PKSIZE^PSNOUT,PKTYPE^PSNOUT W !!,"Local drug ",$P(^PSDRUG(PSNB,0),"^"),!,"matches ",?11,PSNFORM,!,"PACKAGE SIZE: ",PSNSZE,!,"PACKAGE TYPE: ",PSNTPE
55 W !?10,"Is this a match ?" K DIR S DIR("B")="YES",DIR(0)="Y" D ^DIR Q:$D(DIRUT)
56 I Y(0)="NO" Q
57 I Y(0)="YES" D SET^PSNHIT
58 Q
59ASKIT1 S DUNCE=0 D PKSIZE^PSNOUT,PKTYPE^PSNOUT W !!,"Local drug ",$P(^PSDRUG(PSNB,0),"^"),!,"matches ",?11,PSNFORM,!,"PACKAGE SIZE: ",PSNSZE,!,"PACKAGE TYPE: ",PSNTPE
60 W !?10,"Is this a match ?" K DIR S DIR("B")="YES",DIR(0)="Y" D ^DIR Q:$D(DIRUT)
61 I Y(0)="NO" S DUNCE=1,NOMSYN=1
62 I Y(0)="YES" D SET^PSNHIT
63 Q
64EXTD S CMID=$P(^TMP($J,"PSNND",BB),"^",5)
65 Q
66PKI N CS
67 I +$P($G(^PSNDF(50.68,PSNFNM,7)),"^") S CS=$P(^(7),"^") D
68 .S CS=$S(CS?1(1"2n",1"3n"):+CS_"C",+CS=2!(+CS=3)&(CS'["C"):+CS_"A",1:CS)
69 .I $L(CS)=1,$P(^PSDRUG(PSNB,0),"^",3)[CS Q
70 .I $P(^PSDRUG(PSNB,0),"^",3)[$E(CS),$P(^PSDRUG(PSNB,0),"^",3)[$E(CS,2) Q
71 .W !!,"The CS Federal Schedule associated with this drug in the VA Product file"
72 .W !,"represents a DEA, Special Handling code of "_CS,!!
73 .W ?5,"Enter RETURN to continue..." R X:10
74 Q
Note: See TracBrowser for help on using the repository browser.