| [613] | 1 | PSNPPIP ;BIR/DMA-WRT-print a medication instruction sheet ; 02/12/03 16:46
|
|---|
| 2 | ;;4.0; NATIONAL DRUG FILE;**3,7,30,62,84**; 30 Oct 98
|
|---|
| 3 | ;
|
|---|
| 4 | ; Reference to ^PS(59.7 supported by IA #2613
|
|---|
| 5 | ; Reference to ^PSDRUG supported by IA #221
|
|---|
| 6 | ; Reference to ^ps(55 supported by IA #2191
|
|---|
| 7 | ;
|
|---|
| 8 | PICK ;select a drug from file 50
|
|---|
| 9 | D DEFLT
|
|---|
| 10 | I $D(PSNDRUG) Q
|
|---|
| 11 | ;
|
|---|
| 12 | I '$D(^PS(50.621))!'$D(^PS(50.622)) W !,"Patient Medication Instruction Sheets data has not been installed",!! G PAUSE
|
|---|
| 13 | ;
|
|---|
| 14 | K DRG F S DIC=50,DIC(0)="AEQMZ",DIC("S")="I $S('$G(^PSDRUG(+Y,""I"")):1,DT'>^(""I""):1,1:0)" D ^DIC K DIC Q:Y<0 D
|
|---|
| 15 | .I '$G(^PSDRUG(+Y,"ND")) W !,"Drug not matched to NDF" Q
|
|---|
| 16 | .;
|
|---|
| 17 | .S PSNGCN=""
|
|---|
| 18 | .S X=^PSDRUG(+Y,"ND"),X=$P($G(^PSNDF(50.68,+$P(X,"^",3),1)),"^",5) I 'X W !,"Sorry No PMI sheet available" Q
|
|---|
| 19 | .S DRG(+Y)=X
|
|---|
| 20 | I '$O(DRG(0)) G PAUSE
|
|---|
| 21 | EN1 ; entry
|
|---|
| 22 | K DIR S DIR(0)="S^1:English;2:Spanish",DIR("A")="Select Language " S:$D(PSNLANG) DIR("B")=PSNLANG D ^DIR K DIR I $D(DIRUT) G PAUSE
|
|---|
| 23 | ;
|
|---|
| 24 | ;If PSNTYPE=2 then branch to English 50.621 at DOONE
|
|---|
| 25 | ;If PSNTYPE=5 then branch to Spanish 50.622 at DOONE
|
|---|
| 26 | S PSNTYPE=$S(Y=1:2,1:5)
|
|---|
| 27 | ;order in the file is 1=English, 2=Spanish
|
|---|
| 28 | ;
|
|---|
| 29 | S DIR(0)="N^1:100:0",DIR("A")="How many copies? ",DIR("B")=1 D ^DIR K DIR I $D(DIRUT) G PAUSE
|
|---|
| 30 | S NUM=Y
|
|---|
| 31 | K ZTSAVE S (ZTSAVE("PSNTYPE"),ZTSAVE("DRG("),ZTSAVE("NUM"),ZTSAVE("PSNDFN"),ZTSAVE("PSNTRADE"),ZTSAVE("PSRX"))="" S:$D(PSNPRTR) %ZIS("B")=PSNPRTR
|
|---|
| 32 | D EN^XUTMDEVQ("DOMORE^PSNPPIP","Print Medication Information Sheets",.ZTSAVE,.%ZIS) I 'POP G QUIT
|
|---|
| 33 | W !,"No device selected and no PMIS printed",!
|
|---|
| 34 | PAUSE R !,"Press return to continue",X:10
|
|---|
| 35 | QUIT K ^TMP($J,"W"),CNTI,CNTO,DIRUT,DRUG,DRG,IN,J,K,LIN0,LINE,LM,NAM,NUM,PG,POP,PSNGCN,PPIN1,PPIN2,PPIND,RM,QUIT,SPEC,TYP,PSNTYPE,X,Y,ZTDESC,ZTRTN,ZTSAVE,DEFLANG,DEFPRTR,PSNDEV,PSNLANG,PSNPRTR,I,N,L,LENGTH,PROD,P,PSNALPHA
|
|---|
| 36 | K PSNBND,PSNBOLD,PSNEMAP,PSNENG,PSNFLAG,PSNLAST,PSNORM,PSNSP D:'$D(PSODFN) KILL^%ZISS Q
|
|---|
| 37 | Q
|
|---|
| 38 | ;
|
|---|
| 39 | Q
|
|---|
| 40 | ;
|
|---|
| 41 | DOMORE ;multiple
|
|---|
| 42 | S DRG=0 F S DRG=$O(DRG(DRG)) Q:'DRG S PSNGCN=DRG(DRG) D DOONE
|
|---|
| 43 | D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@" Q
|
|---|
| 44 | ;
|
|---|
| 45 | DOONE ;Print one PMI sheet
|
|---|
| 46 | ;needs PSNTYPE=1-6 (English, etc.),NUM=# of copies
|
|---|
| 47 | ;DRG=IFN in file 50
|
|---|
| 48 | ;optional DFN=DFN for a particular patient
|
|---|
| 49 | ;
|
|---|
| 50 | N LINE,LIN0,CNTI,CNTO,X,IN,RM,LM,J,K,DRUG,SPEC,NAM
|
|---|
| 51 | S NUM=$G(NUM,1),PSNTYPE=$G(PSNTYPE,2)
|
|---|
| 52 | ;default is one copy of Standard English
|
|---|
| 53 | K ^TMP($J,"W")
|
|---|
| 54 | I $D(PSNDFN) S DFN=PSNDFN,NAM=$P(^DPT(DFN,0),"^") D DEM^VADPT
|
|---|
| 55 | S LM=3,RM=IOM-5,$P(LIN0," ",LM)="",LINE=LIN0 ;,SPEC("[]")="[] "
|
|---|
| 56 | ;Get drug name -
|
|---|
| 57 | ;1.TRADE NAME from 52 if called from PSO
|
|---|
| 58 | ;2. VA PRINT NAME from 50.68
|
|---|
| 59 | ;3. GENERIC NAME from 50
|
|---|
| 60 | ;
|
|---|
| 61 | K DRUG I $G(PSNTRADE)'="" S DRUG=PSNTRADE
|
|---|
| 62 | I '$D(DRUG) S DRUG=$P(^PSDRUG(DRG,0),"^"),X=$G(^("ND")),J=+X,K=+$P(X,"^",3),X=$P($G(^PSNDF(50.68,K,1)),"^") I X]"" S DRUG=X
|
|---|
| 63 | ;
|
|---|
| 64 | ;NEW CODE Takes GCNSEQNO (PSNGCN) and finds the drug IEN in
|
|---|
| 65 | ;the PMI MAP-English file (50.623) That IEN points to the text
|
|---|
| 66 | ;in the PMIS-English file
|
|---|
| 67 | ;
|
|---|
| 68 | ;Select files based on whether user wants English or Spanish
|
|---|
| 69 | I PSNTYPE=2 S PSNFILE1=50.623 ;PMI-MAP ENGLISH file
|
|---|
| 70 | I PSNTYPE=2 S PSNFILE2=50.621 ;PMI-ENGLISH file
|
|---|
| 71 | I PSNTYPE=5 S PSNFILE1=50.624 ;PMI-MAP SPANISH file
|
|---|
| 72 | I PSNTYPE=5 S PSNFILE2=50.622 ;PMI-SPANISH file
|
|---|
| 73 | ;
|
|---|
| 74 | ; S PSNEMAP=0,PSNENG=""
|
|---|
| 75 | S PSNEMAP="",PSNENG=""
|
|---|
| 76 | ; F S PSNEMAP=$O(^PS(PSNFILE1,PSNEMAP)) Q:PSNEMAP="" D
|
|---|
| 77 | I '$O(^PS(PSNFILE1,"B",PSNGCN,0)) I '$D(PSODFN) W @IOF W !,"Drug is not linked to a valid Medication Information Sheet for language selected" K PSNGCN,PSNDF,PSNPN Q
|
|---|
| 78 | I '$O(^PS(PSNFILE1,"B",PSNGCN,0)) I $D(PSODFN) S PSNPPI("MESSAGE")="Drug is not linked to a valid Medication Information Sheet for language selected",PSNFLAG=0 K PSNGCN,PSNDF,PSNPN W PSNPPI("MESSAGE"),! Q
|
|---|
| 79 | S PSNEMAP=$O(^PS(PSNFILE1,"B",PSNGCN,0)) D
|
|---|
| 80 | .I $P(^PS(PSNFILE1,PSNEMAP,0),U)=PSNGCN D
|
|---|
| 81 | ..S PSNENG=$P(^PS(PSNFILE1,PSNEMAP,0),U,2) ;Drug D0 Eng/Span file
|
|---|
| 82 | I +PSNENG=0 W !,"No PMI sheet available" Q
|
|---|
| 83 | ;
|
|---|
| 84 | S CNTI=0,CNTO=1,PSNSP="" ;NOTE PSNSP is a blank line insert
|
|---|
| 85 | ;
|
|---|
| 86 | IMP ;Important note about the drug of choice
|
|---|
| 87 | ;
|
|---|
| 88 | I $D(IOST(0)) S X="IOINHI;IOINORM;IOINLOW" D ENDR^%ZISS
|
|---|
| 89 | S PSNALPHA=""
|
|---|
| 90 | S PSNALPHA="Z" D TXT1
|
|---|
| 91 | ;
|
|---|
| 92 | TITLE ;Title and phonic pronunciation
|
|---|
| 93 | ;
|
|---|
| 94 | I '$D(^PS(PSNFILE2,+PSNENG,"F")) D
|
|---|
| 95 | .S ^TMP($J,"W",CNTO)=$G(IOINHI)_^PS(PSNFILE2,+PSNENG,CNTI)
|
|---|
| 96 | .S CNTO=CNTO+1
|
|---|
| 97 | ; .S ^TMP($J,"W",CNTO)=PSNSP S CNTO=CNTO+1 ;Insert blank line
|
|---|
| 98 | ;
|
|---|
| 99 | I $D(^PS(PSNFILE2,+PSNENG,"F")) D
|
|---|
| 100 | .S ^TMP($J,"W",CNTO)=$G(IOINHI)_^PS(PSNFILE2,+PSNENG,CNTI)_" "_$G(IOINORM)_^PS(PSNFILE2,+PSNENG,"F",1,0) S CNTO=CNTO+1
|
|---|
| 101 | S ^TMP($J,"W",CNTO)=PSNSP S CNTO=CNTO+1 ;Insert blank line
|
|---|
| 102 | ;
|
|---|
| 103 | ;
|
|---|
| 104 | BRAND ;Common Brand Name
|
|---|
| 105 | ;
|
|---|
| 106 | D ^PSNPPIP1
|
|---|
| 107 | ;
|
|---|
| 108 | F PSNALPHA="W","U","H","S","M","P","I","O","N","D","R" D:$D(^PS(PSNFILE2,+PSNENG,PSNALPHA)) TXT1
|
|---|
| 109 | D PRINT
|
|---|
| 110 | Q
|
|---|
| 111 | ;
|
|---|
| 112 | TXT1 ;Text portion
|
|---|
| 113 | ;
|
|---|
| 114 | S J=0,N=1,LINE(N)="",PSNLAST=999
|
|---|
| 115 | S L=1,LINE(L)="",PSNBOLD="",PSNORM=""
|
|---|
| 116 | ;
|
|---|
| 117 | S PSNLAST=$O(^PS(PSNFILE2,+PSNENG,PSNALPHA,PSNLAST),-1) ;Last subscripT
|
|---|
| 118 | ;
|
|---|
| 119 | F S J=$O(^PS(PSNFILE2,+PSNENG,PSNALPHA,J)) Q:'J D ONELN^PSNPPIP1 D
|
|---|
| 120 | .S LINE=^PS(PSNFILE2,+PSNENG,PSNALPHA,J,0)
|
|---|
| 121 | .I J=PSNLAST D Q
|
|---|
| 122 | ..I (N-1)'=0 S LINE(L)=LINE(N-1)_" "_LINE ;Last lines
|
|---|
| 123 | ..I $L(LINE(L))>IOM D ;S LINE(M)=$E(LINE(L),1,IOM) D
|
|---|
| 124 | ...F I=IOM:-1:1 I $E(LINE(L),I)[" " D Q
|
|---|
| 125 | ....S ^TMP($J,"W",CNTO)=$E(LINE(L),1,I) S CNTO=CNTO+1
|
|---|
| 126 | ....S ^TMP($J,"W",CNTO)=$E(LINE(L),I+1,999)
|
|---|
| 127 | ....S CNTO=CNTO+1
|
|---|
| 128 | ..I $L(LINE(L))'>IOM D
|
|---|
| 129 | ...S ^TMP($J,"W",CNTO)=LINE(L) S CNTO=CNTO+1
|
|---|
| 130 | .I N>1 S LINE(N-1)=LINE(N-1)_" "_$E(LINE,1,A) D ;Middle lines
|
|---|
| 131 | ..I $L(LINE(N-1))<IOM S A=IOM-$L(LINE(N-1)) Q
|
|---|
| 132 | ..D BRK
|
|---|
| 133 | ..S N=N+1,CNTO=CNTO+1
|
|---|
| 134 | .I N=1 S LINE(N)=LINE(N)_" "_LINE,P=LINE(N) D
|
|---|
| 135 | ..F I=1:1:$L(P) I $E(P,I)=":" D
|
|---|
| 136 | ...S PSNBOLD=$G(IOINHI)_$E(P,1,I-1),PSNORM=$G(IOINORM)_$E(P,I,999) ;BOLD Section header
|
|---|
| 137 | ..S LINE(N)=PSNBOLD_PSNORM
|
|---|
| 138 | ..;S LINE(N)=LINE(N)_" "_LINE D ;First line
|
|---|
| 139 | ..I $E(LINE(N),1)[" " S LINE(N)=$E(LINE(N),2,999) ;Remove lead space
|
|---|
| 140 | ..S LENGTH=$L(LINE(N)),A=IOM-LENGTH
|
|---|
| 141 | ..S N=N+1
|
|---|
| 142 | ;
|
|---|
| 143 | S:$D(^PS(PSNFILE2,+PSNENG,PSNALPHA)) ^TMP($J,"W",CNTO)=PSNSP S:$D(^PS(PSNFILE2,+PSNENG,PSNALPHA)) CNTO=CNTO+1 ;Insert blank line
|
|---|
| 144 | Q
|
|---|
| 145 | ;
|
|---|
| 146 | BRK ;Break line between words rather than within a word
|
|---|
| 147 | ;
|
|---|
| 148 | F I=IOM:-1:1 I $E(LINE(N-1),I)[" " D Q
|
|---|
| 149 | .S ^TMP($J,"W",CNTO)=$E(LINE(N-1),1,I)
|
|---|
| 150 | .S LINE(N)=$E(LINE(N-1),I+1,999)_$E(LINE,A+1,999)
|
|---|
| 151 | .I $E(LINE(N),1)[" " S LINE(N)=$E(LINE(N),2,999) ;Remove lead space
|
|---|
| 152 | .S LENGTH=$L(LINE(N)),A=IOM-LENGTH
|
|---|
| 153 | ;
|
|---|
| 154 | Q
|
|---|
| 155 | ;
|
|---|
| 156 | PRINT ;
|
|---|
| 157 | S QUIT=0 F J=1:1:NUM Q:QUIT S PG=1 D HEAD Q:QUIT F K=1:1 Q:'$D(^TMP($J,"W",K)) W ^(K),! I $Y+4>IOSL D HEAD Q:QUIT
|
|---|
| 158 | Q
|
|---|
| 159 | HEAD ;
|
|---|
| 160 | I PG>1,$E(IOST,1,2)="C-" S DIR(0)="E" D ^DIR K DIR I 'Y S QUIT=1 Q
|
|---|
| 161 | ; W:$Y @IOF W !!,LIN0,$S(PSNTYPE<4:"Medication instructions for ",1:"Informaci"_$C(243)_"n sobre su medicina "),DRUG,?70,$S(PSNTYPE<4:"Page ",1:"P"_$C(225)_"gina "),PG S PG=PG+1
|
|---|
| 162 | W:$Y @IOF W !!,?70,$S(PSNTYPE<4:"Page ",1:"P"_$C(225)_"gina "),PG,!,LIN0,$S(PSNTYPE<4:"Medication instructions for ",1:"Informaci"_$C(243)_"n sobre su medicin a "),DRUG S PG=PG+1
|
|---|
| 163 | I $D(NAM) W !!,?2,"Printed for: ",NAM_" ("_VA("BID")_")",?60,$$HTE^XLFDT(+$H),!,?2,"Rx Number: "_$G(PSRX)
|
|---|
| 164 | W !!! Q
|
|---|
| 165 | ;
|
|---|
| 166 | ;
|
|---|
| 167 | DICS ;set DIC("S") to screen out inactives and entries in file 50
|
|---|
| 168 | ;that are not linked through NDF to a PMI sheet
|
|---|
| 169 | N QQQ S QQQ=$G(^PSDRUG(+Y,"ND")),QQQ=$P($G(^PSNDF(50.68,+$P(QQQ,"^",3),1)),"^",5) I QQQ,$D(PSNGCN),$S('$G(^PSDRUG(+Y,"I")):1,DT'>^("I"):1,1:0)
|
|---|
| 170 | S QQQ=$G(^PSDRUG(+Y,0))
|
|---|
| 171 | ;reset naked indicator
|
|---|
| 172 | Q
|
|---|
| 173 | ENOP(PSNDRUG,PSNTRADE,PSRX,PSNDFN) ;
|
|---|
| 174 | ;
|
|---|
| 175 | ; entry point from Outpatient Pharmacy
|
|---|
| 176 | ; PSNDRUG = IFN from the DRUG file (50) ** REQUIRED **
|
|---|
| 177 | ; PSRX = IFN from the PRESCRIPTION file (52) ** OPTIONAL **
|
|---|
| 178 | ; PSNTRADE = Trade Name in printable format ** OPTIONAL **
|
|---|
| 179 | ; PSNDFN = Patient's DFN ** OPTIONAL **
|
|---|
| 180 | ;
|
|---|
| 181 | ; This entry point returns the variable PSNFLAG, it will
|
|---|
| 182 | ; be equal to 1 if the information sheet can be printed or
|
|---|
| 183 | ; it will be equal to 0 if an information sheet cannot be
|
|---|
| 184 | ; printed. If PSNFLAG=0, the variable PSNPPI("MESSAGE") will
|
|---|
| 185 | ; be returned containing a message stating why an information
|
|---|
| 186 | ; sheet could not be printed.
|
|---|
| 187 | ;
|
|---|
| 188 | K DRG,PSNPN
|
|---|
| 189 | S PSNFLAG=1,DRG=PSNDRUG,PSNDF=$G(^PSDRUG(PSNDRUG,"ND"))
|
|---|
| 190 | S PSNPN=$P(PSNDF,"^",3),PSNDF=+PSNDF
|
|---|
| 191 | I 'PSNDF S PSNPPI("MESSAGE")="This drug is not matched to the National Drug File; therefore, a Medication Information Sheet cannot be printed.",PSNFLAG=0 K PSNDF,DRG,PSNPN Q
|
|---|
| 192 | LANGE S DEFLANG=$P($G(^PS(59.7,1,10)),"^",7) I DEFLANG]"" S PSNLANG=$S(DEFLANG=1:"English",1:"Spanish") S:PSNLANG="English" PSNTYPE=2 S:PSNLANG="Spanish" PSNTYPE=5
|
|---|
| 193 | S PSNGCN=$P($G(^PSNDF(50.68,PSNPN,1)),"^",5)
|
|---|
| 194 | ;S PPI=$P($G(^PSNDF(50.68,PSNPN,1)),"^",5)
|
|---|
| 195 | ;
|
|---|
| 196 | I 'PSNGCN S PSNPPI("MESSAGE")="This drug is not linked to a Medication Information Sheet.",PSNFLAG=0 K PSNGCN,DRG,PSNDF,PSNPN Q
|
|---|
| 197 | I PSNFLAG S DRG(DRG)=PSNGCN D EN1
|
|---|
| 198 | K PSNDRUG,PSNTRADE,PSNDF,PSNPN,PSNGCN,DRG
|
|---|
| 199 | ;
|
|---|
| 200 | Q
|
|---|
| 201 | DEFLT S DEFLANG=$P($G(^PS(59.7,1,10)),"^",7) I DEFLANG]"" S PSNLANG=$S(DEFLANG=1:"English",1:"Spanish")
|
|---|
| 202 | N A1 S A1=$$GET1^DIQ(55,$G(PSNDFN)_",",106.1,"I"),DEFLANG=$S(A1=2:"Spanish",A1=1:"English",1:DEFLANG)
|
|---|
| 203 | S DEFPRTR=$P($G(^PS(59.7,1,10)),"^",6) I DEFPRTR]"" S DIC="^%ZIS(1,",DA=DEFPRTR,DR=".01",DIQ="PSNDEV",DIQ(0)="E" D EN^DIQ1 S PSNPRTR=$G(PSNDEV(3.5,DA,.01,DIQ(0)))
|
|---|
| 204 | Q
|
|---|
