126 lines
5.5 KiB
Mathematica
126 lines
5.5 KiB
Mathematica
PSBOMT1 ;BIRMINGHAM/TEJ-BCMA MEDICATION THERAPY REPORT ;Mar 2004
|
|
;;3.0;BAR CODE MED ADMIN;**32**;Mar 2004;Build 32
|
|
;Per VHA Directive 2004-038 (or future revisions regarding same), this routine should not be modified.
|
|
;
|
|
; Reference/IA
|
|
; File 50.7/2880
|
|
; File 52.6/436
|
|
; File 52.7/437
|
|
; File 200/10060
|
|
; EN^PSJBCMA1/2829
|
|
; IEN^PSN50P65/4543
|
|
; DRGIEN^PSS50P7/4662
|
|
; VAC^PSS50/4533
|
|
GETADSO ; GET ALL ADDITIVES FOR ALL ORDERABLE ITEMS
|
|
K PSBAOUT,PSBSOUT
|
|
S XA="" F S XA=$O(PSBOIP("OIP",XA)) Q:XA="" D
|
|
.D LIST^DIC(52.6,"","@;15I","QPI","","","","AOI","","","PSBAOUT")
|
|
.S XB=0 F S XB=$O(PSBAOUT("DILIST",XB)) Q:XB="" D
|
|
..I $P(PSBAOUT("DILIST",XB,0),"^",2)=XA D
|
|
...S TMP("PSBADDS",$J,$P(PSBAOUT("DILIST",XB,0),"^",1))=""
|
|
K PSBAOUT
|
|
; GET ALL SOLUTIONS FOR ALL ORDERABLE ITEMS
|
|
S XA="" F S XA=$O(PSBOIP("OIP",XA)) Q:XA="" D
|
|
.D LIST^DIC(52.7,"","@;9I","QPI","","","","AOI","","","PSBSOUT")
|
|
.S XB=0 F S XB=$O(PSBSOUT("DILIST",XB)) Q:XB="" D
|
|
..I $P(PSBSOUT("DILIST",XB,0),"^",2)=XA D
|
|
...S TMP("PSBSOLS",$J,$P(PSBSOUT("DILIST",XB,0),"^",1))=""
|
|
K PSBSOUT
|
|
Q
|
|
FINDIENS ; USE PSBOIS,PSBADDS AND PSBSOLS TO FIND ALL IENS FOR THE RPT
|
|
;SEARCH FOR UNIT DOSE IENS
|
|
I $D(TMP("PSBOIS",$J)) S XA="" F S XA=$O(TMP("PSBOIS",$J,XA)) Q:XA="" D
|
|
.S PSBDT=PSBSTRT F S PSBDT=$O(^PSB(53.79,"AOIP",PSBXDFN,XA,PSBDT)) Q:PSBDT=""!(PSBDT>PSBSTOP) D
|
|
..S PSBIEN="" F S PSBIEN=$O(^PSB(53.79,"AOIP",PSBXDFN,XA,PSBDT,PSBIEN)) Q:PSBIEN="" D
|
|
...Q:$P(^PSB(53.79,PSBIEN,0),U,9)="N"
|
|
...S TMP("PSBIENS",$J,$$GET1^DIQ(53.79,PSBIEN_",",.06,"I"),PSBIEN)=""
|
|
;SEARCH FOR ADDITIVES
|
|
I $D(TMP("PSBADDS",$J)) S XA="" F S XA=$O(TMP("PSBADDS",$J,XA)) Q:XA="" D
|
|
.S PSBIEN="" F S PSBIEN=$O(^PSB(53.79,"AOIP3",PSBXDFN,PSBIEN)) Q:PSBIEN="" D
|
|
..S XB="" F S XB=$O(^PSB(53.79,"AOIP3",PSBXDFN,PSBIEN,XB)) Q:XB="" D
|
|
...Q:XB'=XA
|
|
...Q:$P(^PSB(53.79,PSBIEN,0),U,9)="N"
|
|
...I $P(^PSB(53.79,PSBIEN,0),"^",6)>PSBSTRT,($P(^PSB(53.79,PSBIEN,0),"^",6)<PSBSTOP) D
|
|
....S TMP("PSBIENS",$J,$$GET1^DIQ(53.79,PSBIEN_",",.06,"I"),PSBIEN)=""
|
|
;SEARCH FOR SOLUTIONS
|
|
I $D(TMP("PSBSOLS",$J)) S XA="" F S XA=$O(TMP("PSBSOLS",$J,XA)) Q:XA="" D
|
|
.S PSBIEN="" F S PSBIEN=$O(^PSB(53.79,"AOIP4",PSBXDFN,PSBIEN)) Q:PSBIEN="" D
|
|
..S XB="" F S XB=$O(^PSB(53.79,"AOIP4",PSBXDFN,PSBIEN,XB)) Q:XB="" D
|
|
...Q:XB'=XA
|
|
...Q:$P(^PSB(53.79,PSBIEN,0),U,9)="N"
|
|
...I $P(^PSB(53.79,PSBIEN,0),"^",6)>PSBSTRT,($P(^PSB(53.79,PSBIEN,0),"^",6)<PSBSTOP) D
|
|
....S TMP("PSBIENS",$J,$$GET1^DIQ(53.79,PSBIEN_",",.06,"I"),PSBIEN)=""
|
|
Q
|
|
HDR ; Header
|
|
W:$Y>1 @IOF
|
|
W:$X>1 !
|
|
S PSBRPNM="BCMA MEDICATION THERAPY REPORT"
|
|
S PSBPGNUM=1,PSBOUTP(0)="",PSBRPT(0)=""
|
|
S PSBPG="Page: "_PSBPGNUM_" of "_$S($O(PSBOUTP(""),-1)=0:1,1:$O(PSBOUTP(""),-1))
|
|
I $P(PSBRPT(0),U,4)="" S $P(PSBRPT(0),U,4)=DUZ(2)
|
|
S PSBPGRM=IOM-($L(PSBPG))
|
|
D:$P(PSBRPT(.1),U,1)="P"
|
|
.K PSBHDR
|
|
.S PSBHDR(1)="BCMA MEDICATION THERAPY REPORT for "
|
|
.S Y=$P(PSBRPT(.1),U,6) D D^DIQ S PSBHDR(1)=PSBHDR(1)_Y_"@" S Y=$P(PSBRPT(.1),U,7) S PSBHDR(1)=PSBHDR(1)_$E(Y_"0000",2,5)_" to "
|
|
.S Y=$P(PSBRPT(.1),U,8) D D^DIQ S PSBHDR(1)=PSBHDR(1)_Y_"@" S Y=$P(PSBRPT(.1),U,9) S PSBHDR(1)=PSBHDR(1)_$E(Y_"0000",2,5)
|
|
.S PSBHDR(2)="Schedule Type(s): --"
|
|
.F Y=1:1:4 I $P(PSBRPT(.2),U,Y) S $P(PSBHDR(2),": ",2)=$P(PSBHDR(2),": ",2)_$S(PSBHDR(2)["--":"",1:"/ ")_$P("Continuous^PRN^On-Call^One-Time",U,Y)_" " S PSBHDR(2)=$TR(PSBHDR(2),"-","")
|
|
.I PSBCFLG S PSBHDR(3)="Include Comments" S PSBHDR(4)=" "
|
|
.E S PSBHDR(3)=" "
|
|
Q
|
|
LEGEND ; Report Legend
|
|
K PSBLGDO
|
|
S PSBLGD("ORDER TYPES","C")="Continuous"
|
|
S PSBLGD("ORDER TYPES","O")="One Time"
|
|
S PSBLGD("ORDER TYPES","OC")="On Call"
|
|
S PSBLGD("ORDER TYPES","P")="PRN (As Needed)"
|
|
S PSB=0 F S PSB=$O(PSBLGD("INITIALS",PSB)) Q:+PSB=0 D
|
|
.S PSBINIT=$$GET1^DIQ(200,PSB_",","INITIAL"),PSBLGD("INITIALS",$S(PSBINIT']" ":"*n/a*",1:PSBINIT))=$$GET1^DIQ(200,PSB_",","NAME")
|
|
.K PSBLGD("INITIALS",PSB)
|
|
S PSBLGDO(0)="REPORT LEGEND"
|
|
S PSBLGDO(1)=""
|
|
S PSBLGDO(2)=$S($G(PSBNO,0):"",1:"SCHEDULE TYPES")
|
|
S PSBLGDO(3)=""
|
|
I '$G(PSBNO,0) S X1="",X2=3 F S X1=$O(PSBLGD("ORDER TYPES",X1)) Q:X1="" S X2=X2+1,PSBLGDO(X2)=X1,$E(PSBLGDO(X2),5)="- "_PSBLGD("ORDER TYPES",X1)
|
|
I $D(PSBLGD("INITIALS")) S $E(PSBLGDO(2),35)="INITIALS" S X1="",X2=3 F S X1=$O(PSBLGD("INITIALS",X1)) Q:X1="" S X2=X2+1,$E(PSBLGDO(X2),35)=X1,$E(PSBLGDO(X2),40)="- "_PSBLGD("INITIALS",X1)
|
|
I ($Y+$O(PSBLGDO(""),-1))>(IOSL-12) D
|
|
.W $$PTFTR^PSBOHDR()
|
|
.D PT^PSBOHDR(PSBXDFN,.PSBHDR)
|
|
I IOSL<1000 F Q:($Y+$O(PSBLGDO(""),-1)+12)>IOSL W !
|
|
W !,$TR($J("",IOM)," ","="),!
|
|
F X1=$O(PSBLGDO("")):1:$O(PSBLGDO(""),-1) W !,PSBLGDO(X1)
|
|
W !!,$TR($J("",IOM)," ","="),!
|
|
Q
|
|
FTR ;
|
|
I (IOSL<100) F Q:$Y>(IOSL-6) W !
|
|
W !,$TR($J("",IOM)," ","=")
|
|
S X="Ward: "_PSBHDR("WARD")_" Room-Bed: "_PSBHDR("ROOM")
|
|
W !,PSBHDR("NAME"),?(IOM-11\2),PSBHDR("SSN"),?(IOM-$L(X)),X
|
|
W !,"BCMA MEDICATION THERAPY REPORT",?(IOM-$L(PSBDTTM)),PSBDTTM
|
|
Q
|
|
MAKELINE(X,CNT) ;LINE OF WHAT'S PASSED IN CNT TIMES
|
|
N Y,Z
|
|
S Y=""
|
|
F Z=1:1:CNT S Y=Y_X
|
|
Q Y
|
|
;
|
|
PARSE(X,CNT) ;Split text for wrapping.
|
|
S CNTX="UOA"_CNT,@CNTX=@CNTX_$E(X,CNT,(CNT+14)),UOAX=""
|
|
F S:$F(@CNTX,", ",+UOAX)>0 UOAX=$F(@CNTX,", ",+UOAX) Q:'$F(@CNTX,", ",+UOAX)
|
|
I UOAX<1 F S:$F(@CNTX," ",+UOAX)>0 UOAX=$F(@CNTX," ",+UOAX) Q:'$F(@CNTX," ",+UOAX)
|
|
I UOAX>1,(($L(UOA)-(CNT+14))>0) S CNTXX=$E(@CNTX,1,UOAX-1),@("UOA"_(CNT+15))=$E(@CNTX,UOAX,UOAX+14),@CNTX=CNTXX
|
|
Q
|
|
;
|
|
PAD(X,CNT) ;
|
|
Q $E(X_$J("",CNT),1,CNT)
|
|
;
|
|
CLEANALL ; KILL ALL TMP LEVELS USED VARIABLES
|
|
K ^TMP("PSB",$J),^TMP("PSJ1",$J),PSBOIP,TMP("PSBADDS",$J),TMP("PSBSOLS",$J)
|
|
K TMP("PSBIENS",$J)
|
|
Q
|
|
;
|
|
CLEANSUM ; KILL ALL BUN THE "PSBIENS" LEVEL
|
|
K ^TMP("PSB",$J),^TMP("PSJ1",$J),TMP("PSBIENS",$J),TMP("PSBOIS",$J),TMP("PSBADDS",$J),TMP("PSBSOLS",$J)
|
|
Q
|