195 lines
8.4 KiB
Mathematica
195 lines
8.4 KiB
Mathematica
PSBO ;BIRMINGHAM/EFC-BCMA OUTPUTS ;Mar 2004
|
|
;;3.0;BAR CODE MED ADMIN;**13,32**;Mar 2004;Build 32
|
|
;Per VHA Directive 2004-038 (or future revisions regarding same), this routine should not be modified.
|
|
; Reference/IA
|
|
; ^DPT(/10035
|
|
; WARD^NURSUT5/3052
|
|
; EN^PSJBCMA/2828
|
|
; ^ORD(101.24/3429
|
|
; ^PSDRUG(/221
|
|
RPC(RESULTS,PSBTYPE,PSBDFN,PSBSTRT,PSBSTOP,PSBINCL,PSBDEV,PSBSORT,PSBOI,PSBWLOC,PSBWSORT,PSBFUTR,PSBORDNM,PSBRCRI,PSBLIST) ;
|
|
;
|
|
; RPC: PSB REPORT
|
|
;
|
|
; Description:
|
|
; Used by the client to create individual patient extracts of
|
|
; CHUI report options to display on the client.
|
|
;
|
|
S RESULTS=$NAME(^TMP("PSBO",$J))
|
|
N PSBIENS,PSBRPT,PSBFDA,DIC,PSBANS
|
|
K ^TMP("PSBO",$J) S ^TMP("PSBO",$J,1)="-1^"
|
|
S DFN=PSBDFN
|
|
D NEW^PSBO1(.PSBRPT,PSBTYPE)
|
|
I +PSBRPT(0)<1 S ^TMP("PSBO",$J,1)="-1^Error: "_$P(PSBRPT(0),U,2) Q
|
|
S PSBIENS=+PSBRPT(0)_","
|
|
S PSBSTRT(0)=$E($P(PSBSTRT,".",2)_"0000",1,4),PSBSTRT=PSBSTRT\1
|
|
S PSBSTOP(0)=$E($P(PSBSTOP,".",2)_"0000",1,4),PSBSTOP=PSBSTOP\1
|
|
D:$G(PSBDEV)]""
|
|
.D NOW^%DTC
|
|
.I $P(PSBDEV,U,2)="" D VAL^DIE(53.69,PSBIENS,.06,"F",PSBDEV,"PSBRET","PSBFDA")
|
|
.I $P(PSBDEV,U,2)'="" D VAL^DIE(53.69,PSBIENS,.06,"F","`"_$P(PSBDEV,U,2),"PSBRET","PSBFDA")
|
|
.D VAL^DIE(53.69,PSBIENS,.07,"F",$S($P(PSBRCRI,U)="QD":$P(PSBRCRI,U,2),1:%),"PSBRET","PSBFDA")
|
|
D:$G(PSBOI)]"" VAL^DIE(53.69,PSBIENS,.09,"F",PSBOI,"PSBRET","PSBFDA")
|
|
S:($G(PSBSORT)']"")&(PSBTYPE'="XA") PSBSORT="P" D VAL^DIE(53.69,PSBIENS,.11,"F",PSBSORT,"PSBRET","PSBFDA")
|
|
D VAL^DIE(53.69,PSBIENS,.12,"F","`"_PSBDFN,"PSBRET","PSBFDA")
|
|
I $G(PSBWLOC)]"" S PSBFDA(53.69,PSBIENS,.13)=PSBWLOC
|
|
D:$G(PSBWSORT)]"" VAL^DIE(53.69,PSBIENS,.15,"F",PSBWSORT,"PSBRET","PSBFDA")
|
|
D VAL^DIE(53.69,PSBIENS,.16,"F",PSBSTRT,"PSBRET","PSBFDA")
|
|
D VAL^DIE(53.69,PSBIENS,.17,"F",PSBSTRT(0),"PSBRET","PSBFDA")
|
|
D VAL^DIE(53.69,PSBIENS,.18,"F",PSBSTOP,"PSBRET","PSBFDA")
|
|
D VAL^DIE(53.69,PSBIENS,.19,"F",PSBSTOP(0),"PSBRET","PSBFDA")
|
|
D:$G(PSBINCL)]""
|
|
.D VAL^DIE(53.69,PSBIENS,.21,"F",+$P(PSBINCL,"^",1),"PSBRET","PSBFDA")
|
|
.D VAL^DIE(53.69,PSBIENS,.22,"F",+$P(PSBINCL,"^",2),"PSBRET","PSBFDA")
|
|
.D VAL^DIE(53.69,PSBIENS,.23,"F",+$P(PSBINCL,"^",3),"PSBRET","PSBFDA")
|
|
.D VAL^DIE(53.69,PSBIENS,.24,"F",+$P(PSBINCL,"^",4),"PSBRET","PSBFDA")
|
|
.D VAL^DIE(53.69,PSBIENS,.28,"F",+$P(PSBINCL,"^",5),"PSBRET","PSBFDA")
|
|
.D VAL^DIE(53.69,PSBIENS,.29,"F",+$P(PSBINCL,"^",6),"PSBRET","PSBFDA")
|
|
D:$G(PSBFUTR)]""
|
|
.D VAL^DIE(53.69,PSBIENS,.25,"F",+$P(PSBFUTR,"^",1),"PSBRET","PSBFDA")
|
|
.D VAL^DIE(53.69,PSBIENS,.26,"F",+$P(PSBFUTR,"^",2),"PSBRET","PSBFDA")
|
|
.D VAL^DIE(53.69,PSBIENS,.27,"F",+$P(PSBFUTR,"^",3),"PSBRET","PSBFDA")
|
|
.D VAL^DIE(53.69,PSBIENS,.41,"F",+$P(PSBFUTR,"^",4),"PSBRET","PSBFDA")
|
|
.D VAL^DIE(53.69,PSBIENS,.61,"F",$TR(PSBFUTR,"^ ","~"),"PSBRET","PSBFDA")
|
|
D FILE^DIE("","PSBFDA")
|
|
I $G(PSBLIST(0),"")]"" D LIST^PSBO1(.PSBLIST)
|
|
I $G(PSBDEV)]"" D PRINT^PSBO1 S RESULTS=$NAME(^TMP("PSBO",$J)) Q
|
|
D HFSOPEN^PSBUTL("RPC") I POP S ^TMP("PSBO",$J,1)="ERROR: UNABLE TO ACCESS HFS DIRECTORY "_$$GET^XPAR("DIV","PSB HFS SCRATCH"),^TMP("PSBO",$J,2)="PLEASE CHECK DIRECTORY WRITE PRIVILEDGES." Q
|
|
U IO D DQ(+PSBIENS)
|
|
D HFSCLOSE^PSBUTL("RPC")
|
|
S RESULTS=$NAME(^TMP("PSBO",$J))
|
|
D:$G(PSBDEV)]"" PRINT^PSBO1
|
|
Q
|
|
;
|
|
XQ(PSBTYPE) ; Called via Kernel Menus
|
|
N PSBANS,PSBANS1,PSBRPT,PSBSAVE,DA,DIK,DR,DDSFILE
|
|
D NEW^PSBO1(.PSBRPT,PSBTYPE)
|
|
I +PSBRPT(0)<1 W !,"Error: ",$P(PSBRPT(0),U,2) S DIR(0)="E" D ^DIR Q
|
|
S DA=+PSBRPT(0),DR="[PSBO "_PSBTYPE_"]",DDSFILE=53.69 D ^DDS
|
|
W @IOF
|
|
I 'PSBSAVE W !,"Cancelling Request..." S DIK="^PSB(53.69," D ^DIK W "Cancelled!"
|
|
D:PSBSAVE
|
|
.;Check Drug to Patient Relationship.
|
|
.I PSBTYPE="BL" S PSBANS="" D CHECK I PSBANS=0!($D(DIRUT)) W !,"Cancelling Request..." S DIK="^PSB(53.69," D ^DIK W "Cancelled!" Q
|
|
.;
|
|
.;Allow "'BROWSER" Device
|
|
.S IOP=$$GET1^DIQ(53.69,DA_",",.06,"I"),PSBSIO=0 I IOP]"" D
|
|
..S IOP="`"_IOP,%ZIS="N"
|
|
..D ^%ZIS
|
|
..I IO=IO(0) S PSBSIO=1
|
|
..D HOME^%ZIS K IOP
|
|
.I $$GET1^DIQ(53.69,DA_",",.06)["BROWSER"!(PSBSIO=1) S IOP=$$GET1^DIQ(53.69,DA_",",.06)_";132" D ^%ZIS U IO D DQ(DA) D ^%ZISC K IOP Q
|
|
.W @IOF,"Submitting Your Report Request to Taskman..."
|
|
.S ZTIO=$$GET1^DIQ(53.69,DA_",",.06)
|
|
.S ZTDTH=$P(^PSB(53.69,DA,0),U,7)
|
|
.S ZTDESC="BCMA - "_$$GET1^DIQ(53.69,DA_",",.05)
|
|
.S ZTRTN="DQ^PSBO("_DA_")"
|
|
.D ^%ZTLOAD
|
|
.W "Submitted!",!,"Your Task Number Is: ",$G(ZTSK),!
|
|
K ^TMP("PSBO",$J)
|
|
Q
|
|
;
|
|
DQ(PSBRPT) ; Dequeue report from Taskman
|
|
N PSBWRD,PSBDFN
|
|
Q:'$D(^PSB(53.69,PSBRPT,0)) ; No Such Report
|
|
S $P(^PSB(53.69,PSBRPT,0),U,8)=$G(ZTSK,"RPC")
|
|
D:$$SETUP @("EN^PSBO"_$P(PSBRPT(0),U,5))
|
|
K ^TMP("PSBO",$J)
|
|
S ZTREQ="@"
|
|
Q
|
|
;
|
|
IOM() ; Returns good margin or not
|
|
Q:IOM'<132 1
|
|
W !,"**************************************************************"
|
|
W !,"* SORRY, Your selected DEVICE does not print 132 columns. *"
|
|
W !,"**************************************************************"
|
|
W !
|
|
Q 0
|
|
;
|
|
VAL(PSBFLDS) ; Validate that fields in PSBFLDS are filled in
|
|
N PSB,PSBFLD,PSBMSG,PSBSTOP,PSBST,PSBDAYS S PSBSTRT=""
|
|
F PSB=1:1 Q:$P(PSBFLDS,";",PSB)="" S PSBFLD=$P(PSBFLDS,";",PSB),PSBFLD(PSBFLD)=$$GET^DDSVAL(53.69,DA,PSBFLD)
|
|
I $D(PSBFLD(.11)) K:$E(PSBFLD(.11))="P" PSBFLD(.13),PSBFLD(.15) K:$E(PSBFLD(.11))="W" PSBFLD(.12)
|
|
S PSB="" F S PSB=$O(PSBFLD(PSB)) Q:PSB="" D:PSBFLD(PSB)=""
|
|
.I '$D(PSBMSG) S PSBMSG(0)="UNABLE TO FILE REQUEST",PSBMSG(1)=" ",PSBMSG(2)="ERROR: MISSING DATA - ALL FIELDS ARE REQUIRED",PSBMSG(3)=" "
|
|
.D FIELD^DID(53.69,PSB,"","TITLE;LABEL","PSB")
|
|
.S Z=" Missing Field: "_$S(PSB("TITLE")]"":PSB("TITLE"),1:PSB("LABEL"))
|
|
.S PSBMSG($O(PSBMSG(""),-1)+1)=Z
|
|
; Check Times
|
|
D:$G(PSBFLD(.16))
|
|
.S PSBSTRT=PSBFLD(.16)+$G(PSBFLD(.17))
|
|
.D:$P($$GET1^DIQ(53.69,DA_",",.01),U)["MH"
|
|
..S PSBDAYS=$$GET1^DIQ(101.24,$$FIND1^DIC(101.24,"","X","ORRP BCMA MAH","B")_",",.42) ;check maxdays
|
|
..S:PSBDAYS="" PSBDAYS=7
|
|
..S X=PSBSTRT\1 D H^%DTC S PSBST=%H+PSBDAYS ;Determine stop date
|
|
.S PSBSTOP=$S($G(PSBFLD(.18)):PSBFLD(.18),1:PSBFLD(.16))+$G(PSBFLD(.19))
|
|
.I PSBSTOP<PSBSTRT S Y=$O(PSBMSG(""),-1)+1,PSBMSG(Y)=" Date: Stop Date/Time is before Start Date/Time"
|
|
.I $P($$GET1^DIQ(53.69,DA_",",.01),U)["MH" S X=PSBSTOP\1 D H^%DTC I %H>PSBST S Y=$O(PSBMSG(""),-1)+1,PSBMSG(Y)=" The date range cannot exceed "_PSBDAYS_" day(s) as defined in the CPRS 'MAXIMUM DAYS BACK' parameter"
|
|
Q:'$D(PSBMSG) ; All is well
|
|
D MSG^DDSUTL(.PSBMSG)
|
|
S DDSERROR=1
|
|
Q
|
|
;
|
|
SETUP() ; Setup parameters for the report in PSBRPT
|
|
N PSBWRDL,PSBINDX,PSBWRDA
|
|
K ^TMP("PSBO",$J)
|
|
F X=0,.1,.2,.3,.4,1 S PSBRPT(X)=$G(^PSB(53.69,PSBRPT,X))
|
|
I $D(^PSB(53.69,PSBRPT,2)) M PSBRPT(2)=^PSB(53.69,PSBRPT,2)
|
|
I $P(PSBRPT(.1),U,1)="P" S PSBDFN=+$P(PSBRPT(.1),U,2) Q:'PSBDFN S ^TMP("PSBO",$J,PSBDFN,0)=$P(^DPT(PSBDFN,0),U)_U_$P(^DPT(PSBDFN,0),U,9),^TMP("PSBO",$J,"B",$P(^DPT(PSBDFN,0),U),PSBDFN)=""
|
|
D:$P(PSBRPT(.1),U,1)="W"
|
|
.S PSBWRD=$P(PSBRPT(.1),U,3) Q:'PSBWRD D WARD^NURSUT5("L^"_PSBWRD,.PSBWRDA)
|
|
.S X="" F S X=$O(PSBWRDA(PSBWRD,2,X)) Q:X="" S PSBWRDL=$P(PSBWRDA(PSBWRD,2,X,.01),U,2) D
|
|
..F PSBDFN=0:0 S PSBDFN=$O(^DPT("CN",PSBWRDL,PSBDFN)) Q:'PSBDFN D
|
|
...S ^TMP("PSBO",$J,PSBDFN,0)=$P(^DPT(PSBDFN,0),U)_U_$P(^DPT(PSBDFN,0),U,9)
|
|
...; Determine Sort or default to Pt Name...
|
|
...S:$P(PSBRPT(.1),U,5)="P" PSBINDX=$P(^DPT(PSBDFN,0),U)
|
|
...I $P(PSBRPT(.1),U,5)="B" S PSBINDX=$P($G(^DPT(PSBDFN,.101)),U) S:PSBINDX="" PSBINDX="** NO ROOM BED **"
|
|
...S:$P(PSBRPT(.1),U,5)="" PSBINDX=$P(^DPT(PSBDFN,0),U)
|
|
...S:$G(PSBINDX)="" PSBINDX=$P(^DPT(PSBDFN,0),U)
|
|
...S ^TMP("PSBO",$J,"B",PSBINDX,PSBDFN)=""
|
|
Q 1
|
|
;
|
|
WRAP(X,Y,Z) ; Quick text wrap
|
|
;
|
|
; Input Parameters Description:
|
|
; X: Left Column of display [Optional]
|
|
; Y: Cols to wrap in [Optional]
|
|
; Z: Text to wrap [Optional]
|
|
;
|
|
N PSB
|
|
F Q:'$L(Z) D
|
|
.W:$X>X !
|
|
.W:$X<X ?X
|
|
.I $L(Z)<Y W Z S Z="" Q
|
|
.F PSB=Y:-1:0 Q:$E(Z,PSB)=" "
|
|
.S:PSB<1 PSB=Y
|
|
.W $E(Z,1,PSB)
|
|
.S Z=$E(Z,PSB+1,250)
|
|
Q ""
|
|
;
|
|
CHECK ;Beginning of PSB*1*10
|
|
K ^TMP("PSJ",$J)
|
|
N PSBDFN,PSBBAR,PSBDRUG,PSBFLAG,PSBPNM,PSBNDX,PSBX
|
|
S PSBFLAG="",PSBBAR=$P($P($G(^PSB(53.69,DA,.3)),U,1),"~",2)
|
|
S PSBDRUG=$$GET1^DIQ(53.69,DA_",",.31)
|
|
S PSBDFN=$$GET1^DIQ(53.69,DA_",",.12,"I") S:$G(PSBDFN) PSBFLAG=1
|
|
D EN^PSJBCMA(PSBDFN)
|
|
F PSBX=0:0 S PSBX=$O(^TMP("PSJ",$J,PSBX)) Q:'PSBX D
|
|
.K Y,PSBORD,PSBPNM,PSBNDX
|
|
.M PSBORD=^TMP("PSJ",$J,PSBX)
|
|
.F PSBNDX=700,850,950 D
|
|
..F Y=0:0 S Y=$O(PSBORD(PSBNDX,Y)) Q:'Y D
|
|
...I $P($G(PSBORD(1)),U,7)'="A" Q
|
|
...S PSBPNM=$P(PSBORD(PSBNDX,Y,0),U,1)
|
|
...I PSBNDX=700,PSBPNM=PSBBAR S PSBFLAG=0 Q
|
|
...I PSBNDX=850,$D(^PSDRUG("A526",PSBBAR,PSBPNM)) S PSBFLAG=0 Q
|
|
...I PSBNDX=950,$D(^PSDRUG("A527",PSBBAR,PSBPNM)) S PSBFLAG=0
|
|
I PSBFLAG=1 D
|
|
.W !,"Patient is not currently on medication: ",PSBDRUG
|
|
.K DIRUT,DIR
|
|
.S DIR("A")="Do you want to continue"
|
|
.S DIR(0)="Y"
|
|
.D ^DIR
|
|
.S PSBANS=+Y W !
|
|
;
|