| 1 | PSNVFY ;BIR/CCH&WRT-verifies matches allows rematch ; 02/08/00 8:45
|
|---|
| 2 | ;;4.0; NATIONAL DRUG FILE;**3,22,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 PSNFL=0,PSNW=0 F PSNB=0:0 S PSNB=$O(^PSNTRAN(PSNB)) Q:'PSNB D CHK I $D(PSNFL) Q:PSNFL
|
|---|
| 8 | DONE W:PSNW=0 !!,?13,"No Data has been generated" K PSNB,PSNFL D KILL Q
|
|---|
| 9 | CHK I $D(PSNFL) Q:PSNFL
|
|---|
| 10 | S PSNP=$G(^PSDRUG(PSNB,"I")) I PSNP,PSNP<DT K ^PSNTRAN(PSNB,0) Q
|
|---|
| 11 | Q:'$D(^PSNTRAN(PSNB,0)) Q:$P(^PSNTRAN(PSNB,0),"^",9)="Y" Q:'$P(^PSNTRAN(PSNB,0),"^",2)
|
|---|
| 12 | S PSNPST=^PSNTRAN(PSNB,0),PSNOLD=$P(^PSDRUG(PSNB,0),U),PSNNEW=$P(^PSNDF(50.68,$P(PSNPST,"^",2),0),"^")
|
|---|
| 13 | START W @IOF W ?2,"LOCAL DRUG NAME: ",PSNOLD S PSNW=1 W:$P(^PSDRUG(PSNB,0),"^",9)=1 ?68,"N/F"
|
|---|
| 14 | W !,?40,"ORDER UNIT:"
|
|---|
| 15 | I $D(^PSDRUG(PSNB,660)) S NODE=^PSDRUG(PSNB,660) I $P(NODE,"^",2) S PSNWRT=$P(NODE,"^",2) I $D(^DIC(51.5)),$D(^DIC(51.5,PSNWRT)) W ?52,$S('$D(PSNWRT):"",1:$P(^DIC(51.5,PSNWRT,0),"^",1))
|
|---|
| 16 | W !,?24,"DISPENSE UNITS/ORDER UNITS: ",$S('$D(NODE):"",1:$P(NODE,"^",5)),!,?37,"DISPENSE UNIT: ",$S('$D(NODE):"",1:$P(NODE,"^",8))
|
|---|
| 17 | W !!,"VA PRODUCT NAME: ",PSNNEW
|
|---|
| 18 | S D0=$P(^PSNTRAN(PSNB,0),"^",1),PSNFNM=$P(^PSNTRAN(PSNB,0),"^",2)
|
|---|
| 19 | S DA=D0,K=PSNFNM,X=$$PROD2^PSNAPIS(DA,K) I X]"",$P(X,"^")]"" W !,"VA PRINT NAME: ",$P(X,"^"),?57,"CMOP ID: ",$P(X,"^",2),!,"VA DISPENSE UNIT: ",$P(X,"^",4)
|
|---|
| 20 | W ?57,"MARKABLE FOR CMOP: " W:$P(X,"^",3)=1 "YES" W:$P(X,"^",3)=0 "NO" W:$P(X,"^",3)="" "NOT MARKED"
|
|---|
| 21 | S PSNSIZE=$P(^PSNTRAN(PSNB,0),"^",5),PSNTYPE=$P(^PSNTRAN(PSNB,0),"^",7)
|
|---|
| 22 | D PKSIZE^PSNOUT,PKTYPE^PSNOUT W !,?5,"PACKAGE SIZE: ",PSNSZE,!,?5,"PACKAGE TYPE: ",PSNTPE
|
|---|
| 23 | S PSNVADC=$P(^PSNTRAN(PSNB,0),"^",3) W !,"VA CLASS: ",$P(^PS(50.605,PSNVADC,0),"^",1)_" "_$P(^PS(50.605,PSNVADC,0),"^",2)
|
|---|
| 24 | W !,"CS FEDERAL SCHEDULE: "_$S($P($G(^PSNDF(50.68,PSNFNM,7)),"^"):$P(^PSNDF(50.68,PSNFNM,7),"^"),1:"")
|
|---|
| 25 | W !,"INGREDIENTS:" D INGRED^PSNOUT
|
|---|
| 26 | S NFI=$P($G(^PSNDF(50.68,PSNFNM,5)),"^"),NFR=$P($G(^PSNDF(50.68,PSNFNM,6,1,0)),"^")
|
|---|
| 27 | W !,"NATIONAL FORMULARY INDICATOR: " W:NFI=1 ?30,"YES" W:NFI=0 ?30,"NO"
|
|---|
| 28 | W !,"NATIONAL FORMULARY RESTRICTION:",!,NFR
|
|---|
| 29 | K D0,Y,PSNSIZE,PSNTYPE,PSNTPE,PSNSZE,PSNCON,STOPIT
|
|---|
| 30 | RESP W !!,"< Enter ""Y"" for yes, ""N"" for no >"
|
|---|
| 31 | W:'$D(Z9) !,"< Press RETURN to Pass to Next Drug >"
|
|---|
| 32 | R !!!,?10,"Is this a match ? ",ANS:DTIME I '$T S ANS="^" S PSNFL=1 Q
|
|---|
| 33 | I ANS?.E1C.E G RESP
|
|---|
| 34 | I ANS="" K ANS Q
|
|---|
| 35 | W ! I ANS["^" S PSNFL=1 Q
|
|---|
| 36 | I "Nn"[$E(ANS) K ANS D BLDIT^PSNCOMP Q:$P(^PSNTRAN(PSNB,0),"^",2)']"" G CHK
|
|---|
| 37 | I ANS["?" D RES2^PSNHELP K ANS G START
|
|---|
| 38 | I "YyNn"'[$E(ANS) W !," Invalid Response " G RESP
|
|---|
| 39 | S $P(^PSNTRAN(PSNB,0),"^",9)="Y",$P(^PSNTRAN(PSNB,0),"^",10)=DUZ
|
|---|
| 40 | Q
|
|---|
| 41 | KILL K ANS,PSNSIZE,PSNSZ,PSNTYP,PSNTYPE,PSNDA,PSNSTDA,PSNDDA,PSNUNDA,PSNCLASS,PSNDF,PSNFNM,PSNFORM,PSNNDF,DIC,PSNFL,NBR,PSNNEW,PSNOLD,PSNPST,X,Y,PSNCON,STOPIT
|
|---|
| 42 | K PSNFN,PSNNAM,PSNNAME,PSNNL,PSNVAR,PSND,PSNDFM,PSNVC,PSNVCL,RM,SL,ZZ,ZZZ,PSNTPE,PSNSZE,VV,VVV,JJ,MJL,KK,IN,PSNODE,PSNOU,NODE,PSNWRT,PSNVADC,PSNENT,PSNF,PSNM,PSNLOC,^TMP($J,"PSNND"),ASC,PSNRAN,PSNV,PSNWR,PSNX,PSNZ,WRT,BB,END,PSNP,PSNW
|
|---|
| 43 | K CODE,DA,DATE,DIR,EEE,FFF,FL,GGG,IEN,J,K,NO31,NOM31,NOMSYN,DUNCE,PP,PSNARY,PSNIEN,PSNP,PTPS,QQ,RR,ST,TT,TTT,WR,XX,XXX,Y,ZXZX,DDD,LIST,PPQ,PSNTRFL,PSNXZ,STOP,PSNPD,PSNUP,PSNINQ,NFI
|
|---|
