PSBO	;BIRMINGHAM/EFC-BCMA OUTPUTS ;Mar 2004
	;;3.0;BAR CODE MED ADMIN;**13,32,2**;Mar 2004;Build 22
	;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")!(PSBTYPE="BZ") 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 !
	; 
