PSJPDRTP ;BIR/MV - PRINT PADE TRANSACTION REPORT; Jun 29, 2022@12:45
;;5.0;INPATIENT MEDICATIONS;**317,435**;16 DEC 97;Build 2
;
; Reference to ^%ZISC is supported by DBIA 10089.
; Reference to ^VA(200 is supported by DBIA 10060.
; Reference to ^XLFDT is supported by DBIA 10103
; Reference to ^DG(40.8 is supported by DBIA 728.
; Reference to ^PSDRUG is supported by DBIA 2192.
; Reference to ^VA(200 is supported by DBIA 10060.
; Reference to ^DPT supported by DBIA 10035
Q
;
EN(PSJINP) ; Write PADE Inventory Report
; Required : PSJINP array
; Input PSJINP("PADEV") = PADE device(s) (pointer to PADE DISPENSING DEVICE #58.63) selected by user
; PSJINP("PSDRG") = Drug(s) (pointer to DRUG #50) selected by user
; PSJINP("PSJCSUB") = CS Federal Schedule(s) selected by user
; PSJINP("PSJDEV",CABIEN) = Pointer to PADE DISPENSING DEVICE (#58.63) file
; PSJINP("PSJDELM") = (D)elimited or formatted (R)eport, selected by user
; PSJINP("PSJDIV") = Division (pointer to MEDICAL CENTER DIVISION #40.8) selected by user
; PSJINP("PSJPSYS" = PADE INVENTORY SYSTEM (#58.601) selected by user
; PSJINP("PSJSUM" = (S)ummary or (D)etail report, selected by user
;
N PSJDELIM,PSJQUIT,PSJLNCNT,PSJIOSL,PSJPTOT,DTOUT,DUOUT
S PSJIOSL=$S($G(IOSL):IOSL-3,1:20)
S PSJDELIM=$G(PSJINP("PSJDELM"))
U IO
I PSJDELIM="D" D DELIM(.PSJINP)
I PSJDELIM="R" D FORMAT(.PSJINP,PSJIOSL)
Q
;
DELIM(PSJINP) ; Output delimited report
N PSJPGTOT,PSJLNCNT,PSJPGCNT
S PSJLNCNT=1,PSJPTOT=1,PSJPGCNT=1
D SRHEAD(.PSJINP,PSJLNCNT,PSJPTOT,PSJPGCNT)
S PSJPGCNT="" F S PSJPGCNT=$O(^TMP($J,"PSJPDRTR",PSJPGCNT)) Q:PSJPGCNT="" D
.S PSJLNCNT=0 F S PSJLNCNT=$O(^TMP($J,"PSJPDRTR",PSJPGCNT,PSJLNCNT)) Q:'PSJLNCNT!$G(PSJQUIT) D
..N PSJLNRAW,PSJLNFMT ; Get output, remove unused pieces in delimited
..S PSJLNRAW=$G(^TMP($J,"PSJPDRTR",PSJPGCNT,PSJLNCNT))
..;PSJ*5.0*435: Change $P(PSJLNRAW,"^",1,16)_"^"_$P(PSJLNRAW,"^",19)
..; to $P(PSJLNRAW,"^",1,15)_"^"_$P(PSJLNRAW,"^",18)
..; so that comments will appear on delimited report.
..S PSJLNFMT=$P(PSJLNRAW,"^",1,15)_"^"_$P(PSJLNRAW,"^",18)
..W !,PSJLNFMT
D ^%ZISC
D EXIT
Q
;
FORMAT(PSJINP,PSJIOSL) ; Output formatted report
N CABNAME,PSJPGTOT,PSJPGCNT,PSJDASH,PSJLNCNT,PSJDLN,PSJCOL
S PSJLNCNT=1
S $P(PSJDASH,"-",131)=""
S PSJPGTOT=$$PGTOT()
D SETCOLS(.PSJINP,.PSJCOL)
S PSJPGCNT=0 F S PSJPGCNT=$O(^TMP($J,"PSJPDRTR",PSJPGCNT)) Q:'PSJPGCNT!$G(PSJQUIT) D
.S PSJDLN=0 F S PSJDLN=$O(^TMP($J,"PSJPDRTR",PSJPGCNT,PSJDLN)) Q:'PSJDLN!$G(PSJQUIT) D
..N LINE,USER,WITNESS
..S LINE=$G(^TMP($J,"PSJPDRTR",PSJPGCNT,PSJDLN))
..I $E(LINE,1,9)="Run Date:" D CONT2^PSJPDRIP(PSJPGCNT,.PSJQUIT) S LINE=$P(LINE,"^")_PSJPGTOT
..; Remove User ID and Witness ID from Formatted Report
..S USER=$P($P(LINE,"^",8),"(") S $P(LINE,"^",8)=USER
..S WITNESS=$P($P(LINE,"^",9),"(") S $P(LINE,"^",9)=WITNESS
..U IO W !?PSJCOL(1),$P(LINE,"^"),?PSJCOL(2),$P(LINE,"^",2),?PSJCOL(3),$P(LINE,"^",3),?PSJCOL(4),$P(LINE,"^",4),?PSJCOL(5),$P(LINE,"^",5)
..W ?PSJCOL(6),$P(LINE,"^",6),?PSJCOL(7),$P(LINE,"^",7),?PSJCOL(8),$P(LINE,"^",8),?PSJCOL(9),$P(LINE,"^",9) I $G(PSJCOL(10)) W ?PSJCOL(10),$P(LINE,"^",10)
D CONT2^PSJPDRIP(PSJPGCNT,.PSJQUIT,1) ; Press return to continue
D ^%ZISC
D EXIT
Q
;
PROCSUM(PSJINP) ; Gather report data
N PSJLNCNT,PSLNOD,PSLNHSTR,PSLNDSTR,PSTMPHDR,II,PSJCOL,PSJI,QTY
N PSJUSRID,PSJWITID,PSJDASH,PSJPGCNT,PSJIOSL,PSJPGTOT,TABMAR,PSDRWR
S PSJIOSL=$S($G(IOSL):IOSL-2,1:20)
D SETCOLS^PSJPDRTP(.PSJINP,.PSJCOL)
S $P(TABMAR," ",40)=" "
S $P(PSJDASH,"-",131)=""
S PSJLNCNT=1,PSJPGCNT=0
D SRHEAD(.PSJINP,.PSJLNCNT,.PSJPGCNT,.PSJPGTOT) ; Report Header
; Loop through each record from File 58.6 returned in ^TMP($J,"TSCREEN", reformat and set in output global ^TMP($J,"PSJPDRTR"
S PSJI=0 F S PSJI=$O(^TMP($J,"TSCREEN","DILIST",PSJI)) Q:'PSJI D
.N PSJCOMM,PSJCABST,PSALTDRG,PSDLOC,PSJSUBDR,PSDRGID
.S PSLNOD=^TMP($J,"TSCREEN","DILIST",PSJI,0)
.; Ignore quantities for WASTE transactions - Display "NA"
.I $P(PSLNOD,"^",7)="WASTE" S $P(PSLNOD,"^",9)="NA",$P(PSLNOD,"^",11)="NA",(QTY,$P(PSLNOD,"^",10))="NA"
.S PSALTDRG="" I $P(PSLNOD,"^",2)="" S PSALTDRG=$P(PSLNOD,"^",19)
.S PSJCABST=$$CABST^PSJPDRIP(PSJINP("PSJPSYS"),$P(PSLNOD,"^",3))
.S PSDLOC=$P(PSLNOD,"^",5) I PSDLOC="~~" S PSDLOC=$S($P(PSLNOD,"^",7)="WASTE":"N/A",1:"UNK")
.S PSJSUBDR=$TR($P(PSLNOD,"^",22),"~~") S:PSJSUBDR="" PSJSUBDR="N/A"
.S PSDRWR=$P(PSLNOD,"^",21) S:$TR(PSDRWR,"~")="" PSDRWR="N/A"
.S PSDLOC=PSDRWR_"_"_PSJSUBDR_"_"_PSDLOC
.S PSDRGID=+$P($G(^PS(58.6,+PSLNOD,0)),"^",3)
.S PSLNHSTR="Item: "_$S(PSALTDRG]"":"*"_PSALTDRG,1:$P(PSLNOD,"^",2))_$S($G(PSDRGID):"("_PSDRGID_")",1:"")_"^^^^^ PADE: "_$P(PSLNOD,"^",3)_PSJCABST_"^^ Item Location: "_$G(PSDLOC)
.I PSJLNCNT>($G(PSJIOSL)-1) D PHEAD(.PSJINP,.PSJLNCNT,.PSJPGCNT,.PSJPGTOT,1) D
..; If same drug spans multiple pages, print "Cont" text
..I PSLNHSTR=PSTMPHDR D CONTRAN("(Cont) "_PSLNHSTR,PSJPGCNT,.PSJLNCNT,.PSJINP)
.; If we're working on a new drug, print the sub-header (e.g., Transaction Date, Type, Qty, etc.)
.I PSLNHSTR'=$G(PSTMPHDR) D
..S PSTMPHDR=PSLNHSTR
..I PSJLNCNT>($G(PSJIOSL)-6) D PHEAD(.PSJINP,.PSJLNCNT,.PSJPGCNT,.PSJPGTOT,1)
..D CONTRAN(PSLNHSTR,PSJPGCNT,.PSJLNCNT,.PSJINP)
.; Arrange the data into output format, set into ^TMP($J,"PSJPDRTR"
.S PSLNDSTR=$$BLDSTR(.PSJINP,PSLNOD,.PSJCOMM)
.I PSJINP("PSJDELM")="D" N PSDLDRG,PSDLCAB,PSDLPAR,PSDLOC D
..S PSDLDRG=$P(PSLNHSTR,"^"),PSDLCAB=$P(PSLNHSTR,"^",6),PSDLPAR=$TR($P($P(PSLNHSTR,"PAR Qty: ",2),"Location:")," ",""),PSDLOC=$P(PSLNHSTR,"Location: ",2)
..S PSDLDRG=$P(PSDLDRG,"Item: ",2),PSDLCAB=$P(PSDLCAB,"PADE: ",2)
..S PSLNDSTR=PSDLDRG_"^"_PSDLCAB_"^"_PSDLOC_"^"_PSLNDSTR
.I PSJLNCNT=1 D
..S ^TMP($J,"PSJPDRTR",PSJPGCNT,PSJLNCNT)="Drug^Cabinet^Location^Date^Transaction Type^Override^Begin Balance^Qty^End Balance^Patient^Patient ID^User^User ID^Witness^Witness ID^^^Comment"
..S PSJLNCNT=PSJLNCNT+1
.S ^TMP($J,"PSJPDRTR",PSJPGCNT,PSJLNCNT)=PSLNDSTR,PSJLNCNT=PSJLNCNT+1
.; If formatted output, print comment on separate line
.I ($G(PSJCOMM)'=""),$G(PSJINP("PSJDELM"))="R" S PSJCOMM=" Comment: "_PSJCOMM,^TMP($J,"PSJPDRTR",PSJPGCNT,PSJLNCNT)=PSJCOMM,PSJLNCNT=PSJLNCNT+1
Q
;
BLDSTR(PSJINP,PSLNOD,PSJCOMM) ; Build output data string
; INPUT: PSJINP() = array of user report input/selections
; PSLNOD = header node from PADE INBOUND TRANSACTION file (#58.6), by way of LIST^DIC call output in ^TMP($J,"TSCREEN"
; OUTPUT: PSLNDSTR = string of report output to be stored in ^TMP($J,"PSJPDRTR"
;
S PSLNDSTR=$$BLDSTR^PSJPDRU1(.PSJINP,PSLNOD,.PSJCOMM)
Q PSLNDSTR
;
SRHEAD(PSJINP,PSJLNCNT,PSJPGCNT,PSJPGTOT) ; Report Header
Q:$G(PSJINP("PSJDELM"))="D"
N PSPGCNT,PSJDIV,CSCHED,PSJTMP,PADECAB,PADEDRG,PSJII,PSJPAT,PSJDASH,USRSTR,TRANSTR,OVRIDE,PSJCABS,PSJSUM,PSJPTSTR
S $P(PSJDASH,"-",131)=""
S PSJPGTOT=$S($G(PSJPGTOT):+$G(PSJPGTOT),1:1)
S PSJDIV=$G(PSJINP("PSJDIV"))
S PSJSUM=$G(PSJINP("PSJSUM"))
S PSJLNCNT=1,PSJPGCNT=PSJPGCNT+1
D PHEAD(.PSJINP,.PSJLNCNT,.PSJPGCNT,.PSJPGTOT)
S CSCHED=$$CSCHED(.PSJINP)
S ^TMP($J,"PSJPDRTR",PSJPGCNT,PSJLNCNT)="CS/Non-CS: "_$S($G(PSJINP("PSJCSUB"))="ALL":"ALL",$G(PSJINP("PSJCSUB"))="N":"N",1:$G(CSCHED)),PSJLNCNT=PSJLNCNT+1
S PSJCABS=$$CABSTR(.PSJINP)
S ^TMP($J,"PSJPDRTR",PSJPGCNT,PSJLNCNT)="PADE"_$S(PSJCABS[",":"(s): ",1:": ")_PSJCABS,PSJLNCNT=PSJLNCNT+1
S PSJPTSTR=$$PTSTR(.PSJINP)
S ^TMP($J,"PSJPDRTR",PSJPGCNT,PSJLNCNT)="Patient: "_PSJPTSTR,PSJLNCNT=PSJLNCNT+1
S PADEDRG=$$DRGSTR(.PSJINP)
S ^TMP($J,"PSJPDRTR",PSJPGCNT,PSJLNCNT)="Item"_$S(PADEDRG[",":"(s): ",1:": ")_PADEDRG,PSJLNCNT=PSJLNCNT+1
S USRSTR=$$USRSTR(.PSJINP)
S ^TMP($J,"PSJPDRTR",PSJPGCNT,PSJLNCNT)="User: "_USRSTR,PSJLNCNT=PSJLNCNT+1
S TRANSTR=$$TRANSTR^PSJPDRIP(.PSJINP)
S ^TMP($J,"PSJPDRTR",PSJPGCNT,PSJLNCNT)="Transaction Type: "_TRANSTR,PSJLNCNT=PSJLNCNT+1
S OVRIDE=$S($G(PSJINP("PSJOVR")):"Y",1:"N")
S ^TMP($J,"PSJPDRTR",PSJPGCNT,PSJLNCNT)="Override Transactions Only?: "_OVRIDE,PSJLNCNT=PSJLNCNT+1
S ^TMP($J,"PSJPDRTR",PSJPGCNT,PSJLNCNT)=PSJDASH,PSJLNCNT=PSJLNCNT+1
Q
;
PHEAD(PSJINP,PSJLNCNT,PSJPGCNT,PSJPGTOT,PSADDPG) ; Page header
Q:$G(PSJINP("PSJDELM"))="D"
N PSJDIV,PAD,LINE,PDASH,PSDIVOUT,PSDCNT,PSDIVSTR
S $P(PDASH,"-",131)=""
S $P(PAD," ",80)=""
S PSJLNCNT=0
; Don't increment page count when called from Report Header
I $G(PSADDPG) S PSJPGCNT=$G(PSJPGCNT)+1
S PSDIVSTR=$G(PSJINP("PSJDIV"))
I PSDIVSTR'="ALL" S PSDIVSTR="",PSJDIV=0,PSDCNT=0 F PSDCNT=0:1 S PSJDIV=$O(PSJINP("PSJDIV",PSJDIV)) Q:'PSJDIV D
.S PSDIVOUT=$P($G(^DG(40.8,+PSJDIV,0)),"^")
.S PSDIVSTR=$S(PSDCNT:PSDIVSTR_","_PSDIVOUT,1:PSDIVOUT)
S LINE="Run Date: "_$P($TR($$FMTE^XLFDT($$NOW^XLFDT,2),"@"," "),":",1,2)_$E(PAD,1,25)_"PADE Transaction Report Summary"_$E(PAD,1,30)_"Page "_PSJPGCNT_" of ^",PSJLNCNT=PSJLNCNT+1
S ^TMP($J,"PSJPDRTR",PSJPGCNT,PSJLNCNT)=LINE,PSJLNCNT=PSJLNCNT+1
S LINE="Run By: "_$P($G(^VA(200,+$G(DUZ),0)),"^")_$E(PAD,1,20)_"Division: "_PSDIVSTR
S ^TMP($J,"PSJPDRTR",PSJPGCNT,PSJLNCNT)=LINE,PSJLNCNT=PSJLNCNT+1
I $G(PSADDPG) S ^TMP($J,"PSJPDRTR",PSJPGCNT,PSJLNCNT)=PDASH,PSJLNCNT=PSJLNCNT+1
Q
EXIT ; Clean up.
N PSJOB
K ^TMP($J,"PSJPDRTR"),^TMP($J,"TSCREEN")
F PSJOB=$J,+$G(ZTSK) K ^TMP(PSJOB,"PSJPAT")
K ZTSK
Q
;
POCKDRG(PSJPSYS,PSJCAB,DRUG,DRWPCK) ; Get Drawer.Pocket location of DRUG in PSJCAB cabinet
N CABIEN,DRGIEN,DRWIEN,DRWNAM,PCKIEN,PCKNAM,ND,LOCNAM,I
Q:'$G(PSJPSYS)!'$G(PSJCAB)!'$G(PSJCAB)
S CABIEN=$$FIND1^DIC(58.6011,","_PSJPSYS_",","MXQ",+$G(PSJCAB),,,"ERR")
S DRWIEN=0 F S DRWIEN=$O(^PS(58.601,PSJPSYS,"DEVICE",CABIEN,"DRAWER",DRWIEN)) Q:'DRWIEN S DRWNAM=$P(^(DRWIEN,0),"^") D
.S PCKIEN=0 F S PCKIEN=$O(^PS(58.601,PSJPSYS,"DEVICE",CABIEN,"DRAWER",DRWIEN,"SUB",PCKIEN)) Q:'PCKIEN S ND=^(PCKIEN,0) I $P(ND,"^",5)=DRUG D
..S PCKNAM=DRWNAM_"_"_$P(ND,"^",3)
..F I=1:1:$L(PCKNAM,"_") S:$P(PCKNAM,"_",I)'="~~" LOCNAM=$G(LOCNAM)_$P(PCKNAM,"_",I)_"_"
..S:$E(LOCNAM,$L(LOCNAM))="_" LOCNAM=$E(LOCNAM,1,$L(LOCNAM)-1)
..S DRWPCK(DRUG,LOCNAM)=$P(ND,"^",2)
Q
;
PGTOT() ; Return calculated number of pages for this report
N PGTOT S PGTOT=$O(^TMP($J,"PSJPDRTR",999999),-1)
Q PGTOT
;
CSCHED(PSJINP) ; Return string of CS Federal Schedules from array PSJINP("PSJCSUB",SCHEDULE)
K CSCHED N PSJTMP
S CSCHED=$G(PSJINP("PSJCSUB")) I '(CSCHED="N") S CSCHED="CS (" D
.S PSJTMP="" F S PSJTMP=$O(PSJINP("PSJCSUB",PSJTMP)) Q:PSJTMP="" S CSCHED=CSCHED_PSJTMP_","
.I $E(CSCHED,$L(CSCHED))="," S CSCHED=$E(CSCHED,1,$L(CSCHED)-1)_")"
Q CSCHED
;
CABSTR(PSJINP) ; Return string of PADE cabinets from array PSJINP("PADEV",CABINET)
K CABSTR N PSJTMP,PSJII
I $G(PSJINP("PADEV"))="ALL" Q "ALL"
S PSJTMP="" F PSJII=0:1 S PSJTMP=$O(PSJINP("PADEV",PSJTMP)) Q:PSJTMP="" D
.S CABSTR=$S(PSJII:CABSTR_",",1:"")_PSJTMP
Q CABSTR
;
DRGSTR(PSJINP) ; Return string of PADE drugs selected by user from PSJINP("PSDRG",DRUG IEN)
N PADEDRG
I $G(PSJINP("PSDRG"))="ALL" Q "ALL"
S PADEDRG="",PSJTMP="" F PSJII=0:1 S PSJTMP=$O(PSJINP("PSDRG",PSJTMP)) Q:PSJTMP="" D
.I $G(PSJTMP),$D(^PSDRUG(+PSJTMP)) S PADEDRG=$S(PSJII:(PADEDRG_","),1:"")_$P($G(^PSDRUG(+PSJTMP,0)),"^") Q
.I $E(PSJTMP)="*" S PADEDRG=$S(PSJII:(PADEDRG_","),1:"")_PSJTMP
S:$E(PADEDRG,$L(PADEDRG)) PADEDRG=$E(PADEDRG,1,$L(PADEDRG)=1)
Q PADEDRG
;
PTSTR(PSJINP) ; Return string of patients selected by user from PSJINP("PSJPAT",DFN)
N PSJTMP,PATSTR,PSJII,PSJDONE
S PATSTR=""
I $G(^TMP($J,"PSJPAT"))="ALL"!($G(^TMP($J,"PSJPAT"))="NONE") Q $G(^TMP($J,"PSJPAT"))
S PSJTMP="" F PSJII=0:1 S PSJTMP=$O(^TMP($J,"PSJPAT",PSJTMP)) Q:PSJTMP=""!$G(PSJDONE) D
.I $L($G(PATSTR))+$L(^TMP($J,"PSJPAT",PSJTMP))>250 S PATSTR=PATSTR_">> more..." S PSJDONE=1 Q
.S PATSTR=$S(PSJII:(PATSTR_","),1:"")_^TMP($J,"PSJPAT",PSJTMP)
Q PATSTR
;
USRSTR(PSJINP) ; Return string of Users selected by user from PSJINP("PSJUSER")
N PSJTMP,USRSTR,PSJII,PSJDONE
I $G(PSJINP("PSJUSER"))="ALL" Q PSJINP("PSJUSER")
S PSJTMP="" F PSJII=0:1 S PSJTMP=$O(PSJINP("PSJUSER",PSJTMP)) Q:PSJTMP=""!$G(PSJDONE) D
.I $L($G(USRSTR))+PSJINP("PSJUSER",PSJTMP)>250 S USRSTR=USRSTR_">> more..." S PSJDONE=1 Q
.S USRSTR=$S(PSJII:(USRSTR_","),1:"")_PSJINP("PSJUSER",PSJTMP)_" ("_PSJTMP_")"
Q USRSTR
;
TSCREEN(PSJY,PSJINP) ; Screen PADE TRANSACTION file (#58.6) using user input criteria
;
N PSJOK,PSJTDT,PSJPSYSE,PSJDIV,PSJBDT,PSJEDT,PSJCAB,PSJCSUB,PSJDRG,PSJSUM,PSJUSER,PSJTCAB,PSJDELM,PSJTPAT,PSJTADRG,PSJTADNM,PSJXPTNM,PSJOVQ
N PSJTDT,PSJTCAB,PSJTDRUG,PSJTSUB,PSJPTYP,PSJPAT,PSJTNOD0,PSJTORD,PSJOVR,PSJTRANS,PSJTTRAN,PSJTUSR,PSJTNOD1,PSJPTFLG,PSJOB,PSJTNOD3,PSJTSYS
S PSJOK=1
S PSJTNOD0=$G(^PS(58.6,+PSJY,0))
S PSJTNOD1=$G(^PS(58.6,+PSJY,1))
S PSJTNOD3=$G(^PS(58.6,+PSJY,3))
S PSJPSYSE=$G(PSJINP("PSJPSYSE"))
S PSJTSYS=$P(PSJTNOD1,"^",3)
I (PSJPSYSE'=""),(PSJTSYS'="") Q:(PSJPSYSE'=PSJTSYS) 0
S PSJDIV=$G(PSJINP("PSJDIV"))
S PSJBDT=$G(PSJINP("PSJBDT"))
S PSJEDT=$G(PSJINP("PSJEDT"))
M PSJCAB=PSJINP("PADEV")
M PSJCSUB=PSJINP("PSJCSUB")
M PSJDRG=PSJINP("PSDRG")
S PSJSUM=$G(PSJINP("PSJUM"))
M PSJUSER=PSJINP("PSJUSER")
M PSJTRANS=PSJINP("PSJTRANS")
M PSJPAT=PSJINP("PSJPAT")
D CNVTYP^PSJPDRIP(.PSJTRANS,.PSJPTYP)
S PSJDELM=$G(PSJINP("PSJDELM"))
S PSJOVR=$G(PSJINP("PSJOVR"))
; Transaction Date
S PSJTDT=$P(PSJTNOD0,"^")
I PSJBDT>PSJTDT!(PSJEDT<PSJTDT) Q 0
; PADE Device (Cabinet)
S PSJTCAB=$P(PSJTNOD0,"^",2) Q:PSJTCAB="" 0
I '$D(PSJCAB(PSJTCAB)) Q 0
; Drug Item
S PSJTDRUG=$P(PSJTNOD0,"^",3)
; Alternate Drug ID and Name
S PSJTADRG=$P(PSJTNOD1,"^",7),PSJTADNM=$P(PSJTNOD1,"^",6)
I '($G(PSJDRG)="ALL") Q:PSJTDRUG=""&(PSJTADRG="") 0
I '($G(PSJDRG)="ALL") I '$D(PSJDRG(+PSJTDRUG))&'$D(PSJDRG("*"_PSJTADNM)) Q 0
; Controlled Substance Schedule
S PSJTSUB=$$GETCLASS^PSJPDRIN(PSJTDRUG)
I 'PSJTDRUG&$L($G(PSJTADRG)) S PSJTSUB=0
Q:PSJTSUB="" 0
I '$D(PSJCSUB(PSJTSUB)) Q 0
; Transaction Type
S PSJTTRAN=$P(PSJTNOD0,"^",5) Q:PSJTTRAN="" 0
I '$D(PSJPTYP(PSJTTRAN)) Q 0
; Patient
S PSJTPAT=$P(PSJTNOD0,"^",15) S PSJTPAT=$S(PSJTPAT="":+PSJTPAT,1:PSJTPAT)
I 'PSJTPAT S PSJTPAT=$P(PSJTNOD3,"^",7) S PSJTPAT=$S(PSJTPAT="":+PSJTPAT,1:PSJTPAT)
S PSJXPTNM=$P(PSJTNOD3,"^",4) I 'PSJTPAT&(PSJXPTNM]"") S PSJTPAT="*"
S PSJPTFLG=$$PTTRFLG^PSJPDRU1(.PSJINP)
; If only "NO PATIENT" selected, quit if patient in transaction
S PSJOB=$S($G(PSJINP("PSJTSK")):PSJINP("PSJTSK"),1:$J)
I PSJPTFLG=2,'$D(^TMP(PSJOB,"PSJPAT",PSJTPAT)) Q 0
; If not "NO PATIENT", and not "ALL" patients,
I 'PSJPTFLG,(PSJTPAT'=""),(PSJTPAT'=0) Q 0
; User
S PSJTUSR=$P($G(^PS(58.6,+PSJY,5)),"^") Q:PSJTUSR="" 0
I ($G(PSJUSER)'="ALL")&($D(PSJUSER)>1)&'$D(PSJUSER(PSJTUSR)) Q 0
; Overrides
S PSJTORD=$P($G(^PS(58.6,+PSJY,1)),"^")
I PSJOVR D Q:$G(PSJOVQ) 0
.I '$$PTRNSTYP^PSJPAD7I(PSJTTRAN) S PSJOVQ=1 Q
.I (PSJTORD'="")&(PSJTORD'="OVERRIDE") S PSJOVQ=1 Q
Q 1
;
SETCOLS(PSJINP,COL) ; Report column widths
S COL(1)=0,COL(2)=15,COL(3)=26,COL(4)=30,COL(5)=38,COL(6)=46,COL(7)=53,COL(8)=84,COL(9)=108
Q
;
SECTHD1() ; Sub-header line 1
N STRING
S STRING="Transaction^Trans^^ Beg^^ End^^Transaction^Witnessed"
Q STRING
;
SECTHD2() ; Sub-header line 2
N STRING
S STRING="Date/Time^Type^O-R^ Bal^ Qty^ Bal^Patient^By^By"
Q STRING
;
CONTRAN(PSLNHSTR,PSJPGCNT,PSJLNCNT,PSJINP) ; Print "Continued" message when listing spans multiple pages
; Don't output "Cont" text if delimited output
Q:($G(PSJINP("PSJDELM"))="D")
I PSJLNCNT>($G(PSJIOSL)-6) D PHEAD(.PSJINP,.PSJLNCNT,.PSJPGCNT,.PSJPGTOT,1)
S ^TMP($J,"PSJPDRTR",PSJPGCNT,PSJLNCNT)="",PSJLNCNT=PSJLNCNT+1
S ^TMP($J,"PSJPDRTR",PSJPGCNT,PSJLNCNT)=PSLNHSTR,PSJLNCNT=PSJLNCNT+1
S ^TMP($J,"PSJPDRTR",PSJPGCNT,PSJLNCNT)="",PSJLNCNT=PSJLNCNT+1
S ^TMP($J,"PSJPDRTR",PSJPGCNT,PSJLNCNT)=$$SECTHD1^PSJPDRTP(),PSJLNCNT=PSJLNCNT+1
S ^TMP($J,"PSJPDRTR",PSJPGCNT,PSJLNCNT)=$$SECTHD2^PSJPDRTP(),PSJLNCNT=PSJLNCNT+1
S ^TMP($J,"PSJPDRTR",PSJPGCNT,PSJLNCNT)=PSJDASH,PSJLNCNT=PSJLNCNT+1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSJPDRTP 16212 printed Sep 23, 2025@19:44:56 Page 2
PSJPDRTP ;BIR/MV - PRINT PADE TRANSACTION REPORT; Jun 29, 2022@12:45
+1 ;;5.0;INPATIENT MEDICATIONS;**317,435**;16 DEC 97;Build 2
+2 ;
+3 ; Reference to ^%ZISC is supported by DBIA 10089.
+4 ; Reference to ^VA(200 is supported by DBIA 10060.
+5 ; Reference to ^XLFDT is supported by DBIA 10103
+6 ; Reference to ^DG(40.8 is supported by DBIA 728.
+7 ; Reference to ^PSDRUG is supported by DBIA 2192.
+8 ; Reference to ^VA(200 is supported by DBIA 10060.
+9 ; Reference to ^DPT supported by DBIA 10035
+10 QUIT
+11 ;
EN(PSJINP) ; Write PADE Inventory Report
+1 ; Required : PSJINP array
+2 ; Input PSJINP("PADEV") = PADE device(s) (pointer to PADE DISPENSING DEVICE #58.63) selected by user
+3 ; PSJINP("PSDRG") = Drug(s) (pointer to DRUG #50) selected by user
+4 ; PSJINP("PSJCSUB") = CS Federal Schedule(s) selected by user
+5 ; PSJINP("PSJDEV",CABIEN) = Pointer to PADE DISPENSING DEVICE (#58.63) file
+6 ; PSJINP("PSJDELM") = (D)elimited or formatted (R)eport, selected by user
+7 ; PSJINP("PSJDIV") = Division (pointer to MEDICAL CENTER DIVISION #40.8) selected by user
+8 ; PSJINP("PSJPSYS" = PADE INVENTORY SYSTEM (#58.601) selected by user
+9 ; PSJINP("PSJSUM" = (S)ummary or (D)etail report, selected by user
+10 ;
+11 NEW PSJDELIM,PSJQUIT,PSJLNCNT,PSJIOSL,PSJPTOT,DTOUT,DUOUT
+12 SET PSJIOSL=$SELECT($GET(IOSL):IOSL-3,1:20)
+13 SET PSJDELIM=$GET(PSJINP("PSJDELM"))
+14 USE IO
+15 IF PSJDELIM="D"
DO DELIM(.PSJINP)
+16 IF PSJDELIM="R"
DO FORMAT(.PSJINP,PSJIOSL)
+17 QUIT
+18 ;
DELIM(PSJINP) ; Output delimited report
+1 NEW PSJPGTOT,PSJLNCNT,PSJPGCNT
+2 SET PSJLNCNT=1
SET PSJPTOT=1
SET PSJPGCNT=1
+3 DO SRHEAD(.PSJINP,PSJLNCNT,PSJPTOT,PSJPGCNT)
+4 SET PSJPGCNT=""
FOR
SET PSJPGCNT=$ORDER(^TMP($JOB,"PSJPDRTR",PSJPGCNT))
if PSJPGCNT=""
QUIT
Begin DoDot:1
+5 SET PSJLNCNT=0
FOR
SET PSJLNCNT=$ORDER(^TMP($JOB,"PSJPDRTR",PSJPGCNT,PSJLNCNT))
if 'PSJLNCNT!$GET(PSJQUIT)
QUIT
Begin DoDot:2
+6 ; Get output, remove unused pieces in delimited
NEW PSJLNRAW,PSJLNFMT
+7 SET PSJLNRAW=$GET(^TMP($JOB,"PSJPDRTR",PSJPGCNT,PSJLNCNT))
+8 ;PSJ*5.0*435: Change $P(PSJLNRAW,"^",1,16)_"^"_$P(PSJLNRAW,"^",19)
+9 ; to $P(PSJLNRAW,"^",1,15)_"^"_$P(PSJLNRAW,"^",18)
+10 ; so that comments will appear on delimited report.
+11 SET PSJLNFMT=$PIECE(PSJLNRAW,"^",1,15)_"^"_$PIECE(PSJLNRAW,"^",18)
+12 WRITE !,PSJLNFMT
End DoDot:2
End DoDot:1
+13 DO ^%ZISC
+14 DO EXIT
+15 QUIT
+16 ;
FORMAT(PSJINP,PSJIOSL) ; Output formatted report
+1 NEW CABNAME,PSJPGTOT,PSJPGCNT,PSJDASH,PSJLNCNT,PSJDLN,PSJCOL
+2 SET PSJLNCNT=1
+3 SET $PIECE(PSJDASH,"-",131)=""
+4 SET PSJPGTOT=$$PGTOT()
+5 DO SETCOLS(.PSJINP,.PSJCOL)
+6 SET PSJPGCNT=0
FOR
SET PSJPGCNT=$ORDER(^TMP($JOB,"PSJPDRTR",PSJPGCNT))
if 'PSJPGCNT!$GET(PSJQUIT)
QUIT
Begin DoDot:1
+7 SET PSJDLN=0
FOR
SET PSJDLN=$ORDER(^TMP($JOB,"PSJPDRTR",PSJPGCNT,PSJDLN))
if 'PSJDLN!$GET(PSJQUIT)
QUIT
Begin DoDot:2
+8 NEW LINE,USER,WITNESS
+9 SET LINE=$GET(^TMP($JOB,"PSJPDRTR",PSJPGCNT,PSJDLN))
+10 IF $EXTRACT(LINE,1,9)="Run Date:"
DO CONT2^PSJPDRIP(PSJPGCNT,.PSJQUIT)
SET LINE=$PIECE(LINE,"^")_PSJPGTOT
+11 ; Remove User ID and Witness ID from Formatted Report
+12 SET USER=$PIECE($PIECE(LINE,"^",8),"(")
SET $PIECE(LINE,"^",8)=USER
+13 SET WITNESS=$PIECE($PIECE(LINE,"^",9),"(")
SET $PIECE(LINE,"^",9)=WITNESS
+14 USE IO
WRITE !?PSJCOL(1),$PIECE(LINE,"^"),?PSJCOL(2),$PIECE(LINE,"^",2),?PSJCOL(3),$PIECE(LINE,"^",3),?PSJCOL(4),$PIECE(LINE,"^",4),?PSJCOL(5),$PIECE(LINE,"^",5)
+15 WRITE ?PSJCOL(6),$PIECE(LINE,"^",6),?PSJCOL(7),$PIECE(LINE,"^",7),?PSJCOL(8),$PIECE(LINE,"^",8),?PSJCOL(9),$PIECE(LINE,"^",9)
IF $GET(PSJCOL(10))
WRITE ?PSJCOL(10),$PIECE(LINE,"^",10)
End DoDot:2
End DoDot:1
+16 ; Press return to continue
DO CONT2^PSJPDRIP(PSJPGCNT,.PSJQUIT,1)
+17 DO ^%ZISC
+18 DO EXIT
+19 QUIT
+20 ;
PROCSUM(PSJINP) ; Gather report data
+1 NEW PSJLNCNT,PSLNOD,PSLNHSTR,PSLNDSTR,PSTMPHDR,II,PSJCOL,PSJI,QTY
+2 NEW PSJUSRID,PSJWITID,PSJDASH,PSJPGCNT,PSJIOSL,PSJPGTOT,TABMAR,PSDRWR
+3 SET PSJIOSL=$SELECT($GET(IOSL):IOSL-2,1:20)
+4 DO SETCOLS^PSJPDRTP(.PSJINP,.PSJCOL)
+5 SET $PIECE(TABMAR," ",40)=" "
+6 SET $PIECE(PSJDASH,"-",131)=""
+7 SET PSJLNCNT=1
SET PSJPGCNT=0
+8 ; Report Header
DO SRHEAD(.PSJINP,.PSJLNCNT,.PSJPGCNT,.PSJPGTOT)
+9 ; Loop through each record from File 58.6 returned in ^TMP($J,"TSCREEN", reformat and set in output global ^TMP($J,"PSJPDRTR"
+10 SET PSJI=0
FOR
SET PSJI=$ORDER(^TMP($JOB,"TSCREEN","DILIST",PSJI))
if 'PSJI
QUIT
Begin DoDot:1
+11 NEW PSJCOMM,PSJCABST,PSALTDRG,PSDLOC,PSJSUBDR,PSDRGID
+12 SET PSLNOD=^TMP($JOB,"TSCREEN","DILIST",PSJI,0)
+13 ; Ignore quantities for WASTE transactions - Display "NA"
+14 IF $PIECE(PSLNOD,"^",7)="WASTE"
SET $PIECE(PSLNOD,"^",9)="NA"
SET $PIECE(PSLNOD,"^",11)="NA"
SET (QTY,$PIECE(PSLNOD,"^",10))="NA"
+15 SET PSALTDRG=""
IF $PIECE(PSLNOD,"^",2)=""
SET PSALTDRG=$PIECE(PSLNOD,"^",19)
+16 SET PSJCABST=$$CABST^PSJPDRIP(PSJINP("PSJPSYS"),$PIECE(PSLNOD,"^",3))
+17 SET PSDLOC=$PIECE(PSLNOD,"^",5)
IF PSDLOC="~~"
SET PSDLOC=$SELECT($PIECE(PSLNOD,"^",7)="WASTE":"N/A",1:"UNK")
+18 SET PSJSUBDR=$TRANSLATE($PIECE(PSLNOD,"^",22),"~~")
if PSJSUBDR=""
SET PSJSUBDR="N/A"
+19 SET PSDRWR=$PIECE(PSLNOD,"^",21)
if $TRANSLATE(PSDRWR,"~")=""
SET PSDRWR="N/A"
+20 SET PSDLOC=PSDRWR_"_"_PSJSUBDR_"_"_PSDLOC
+21 SET PSDRGID=+$PIECE($GET(^PS(58.6,+PSLNOD,0)),"^",3)
+22 SET PSLNHSTR="Item: "_$SELECT(PSALTDRG]"":"*"_PSALTDRG,1:$PIECE(PSLNOD,"^",2))_$SELECT($GET(PSDRGID):"("_PSDRGID_")",1:"")_"^^^^^ PADE: "_$PIECE(PSLNOD,"^",3)_PSJCABST_"^^ Item Location: "_$GET(PSDLOC)
+23 IF PSJLNCNT>($GET(PSJIOSL)-1)
DO PHEAD(.PSJINP,.PSJLNCNT,.PSJPGCNT,.PSJPGTOT,1)
Begin DoDot:2
+24 ; If same drug spans multiple pages, print "Cont" text
+25 IF PSLNHSTR=PSTMPHDR
DO CONTRAN("(Cont) "_PSLNHSTR,PSJPGCNT,.PSJLNCNT,.PSJINP)
End DoDot:2
+26 ; If we're working on a new drug, print the sub-header (e.g., Transaction Date, Type, Qty, etc.)
+27 IF PSLNHSTR'=$GET(PSTMPHDR)
Begin DoDot:2
+28 SET PSTMPHDR=PSLNHSTR
+29 IF PSJLNCNT>($GET(PSJIOSL)-6)
DO PHEAD(.PSJINP,.PSJLNCNT,.PSJPGCNT,.PSJPGTOT,1)
+30 DO CONTRAN(PSLNHSTR,PSJPGCNT,.PSJLNCNT,.PSJINP)
End DoDot:2
+31 ; Arrange the data into output format, set into ^TMP($J,"PSJPDRTR"
+32 SET PSLNDSTR=$$BLDSTR(.PSJINP,PSLNOD,.PSJCOMM)
+33 IF PSJINP("PSJDELM")="D"
NEW PSDLDRG,PSDLCAB,PSDLPAR,PSDLOC
Begin DoDot:2
+34 SET PSDLDRG=$PIECE(PSLNHSTR,"^")
SET PSDLCAB=$PIECE(PSLNHSTR,"^",6)
SET PSDLPAR=$TRANSLATE($PIECE($PIECE(PSLNHSTR,"PAR Qty: ",2),"Location:")," ","")
SET PSDLOC=$PIECE(PSLNHSTR,"Location: ",2)
+35 SET PSDLDRG=$PIECE(PSDLDRG,"Item: ",2)
SET PSDLCAB=$PIECE(PSDLCAB,"PADE: ",2)
+36 SET PSLNDSTR=PSDLDRG_"^"_PSDLCAB_"^"_PSDLOC_"^"_PSLNDSTR
End DoDot:2
+37 IF PSJLNCNT=1
Begin DoDot:2
+38 SET ^TMP($JOB,"PSJPDRTR",PSJPGCNT,PSJLNCNT)="Drug^Cabinet^Location^Date^Transaction Type^Override^Begin Balance^Qty^End Balance^Patient^Patient ID^User^User ID^Witness^Witness ID^^^Comment"
+39 SET PSJLNCNT=PSJLNCNT+1
End DoDot:2
+40 SET ^TMP($JOB,"PSJPDRTR",PSJPGCNT,PSJLNCNT)=PSLNDSTR
SET PSJLNCNT=PSJLNCNT+1
+41 ; If formatted output, print comment on separate line
+42 IF ($GET(PSJCOMM)'="")
IF $GET(PSJINP("PSJDELM"))="R"
SET PSJCOMM=" Comment: "_PSJCOMM
SET ^TMP($JOB,"PSJPDRTR",PSJPGCNT,PSJLNCNT)=PSJCOMM
SET PSJLNCNT=PSJLNCNT+1
End DoDot:1
+43 QUIT
+44 ;
BLDSTR(PSJINP,PSLNOD,PSJCOMM) ; Build output data string
+1 ; INPUT: PSJINP() = array of user report input/selections
+2 ; PSLNOD = header node from PADE INBOUND TRANSACTION file (#58.6), by way of LIST^DIC call output in ^TMP($J,"TSCREEN"
+3 ; OUTPUT: PSLNDSTR = string of report output to be stored in ^TMP($J,"PSJPDRTR"
+4 ;
+5 SET PSLNDSTR=$$BLDSTR^PSJPDRU1(.PSJINP,PSLNOD,.PSJCOMM)
+6 QUIT PSLNDSTR
+7 ;
SRHEAD(PSJINP,PSJLNCNT,PSJPGCNT,PSJPGTOT) ; Report Header
+1 if $GET(PSJINP("PSJDELM"))="D"
QUIT
+2 NEW PSPGCNT,PSJDIV,CSCHED,PSJTMP,PADECAB,PADEDRG,PSJII,PSJPAT,PSJDASH,USRSTR,TRANSTR,OVRIDE,PSJCABS,PSJSUM,PSJPTSTR
+3 SET $PIECE(PSJDASH,"-",131)=""
+4 SET PSJPGTOT=$SELECT($GET(PSJPGTOT):+$GET(PSJPGTOT),1:1)
+5 SET PSJDIV=$GET(PSJINP("PSJDIV"))
+6 SET PSJSUM=$GET(PSJINP("PSJSUM"))
+7 SET PSJLNCNT=1
SET PSJPGCNT=PSJPGCNT+1
+8 DO PHEAD(.PSJINP,.PSJLNCNT,.PSJPGCNT,.PSJPGTOT)
+9 SET CSCHED=$$CSCHED(.PSJINP)
+10 SET ^TMP($JOB,"PSJPDRTR",PSJPGCNT,PSJLNCNT)="CS/Non-CS: "_$SELECT($GET(PSJINP("PSJCSUB"))="ALL":"ALL",$GET(PSJINP("PSJCSUB"))="N":"N",1:$GET(CSCHED))
SET PSJLNCNT=PSJLNCNT+1
+11 SET PSJCABS=$$CABSTR(.PSJINP)
+12 SET ^TMP($JOB,"PSJPDRTR",PSJPGCNT,PSJLNCNT)="PADE"_$SELECT(PSJCABS[",":"(s): ",1:": ")_PSJCABS
SET PSJLNCNT=PSJLNCNT+1
+13 SET PSJPTSTR=$$PTSTR(.PSJINP)
+14 SET ^TMP($JOB,"PSJPDRTR",PSJPGCNT,PSJLNCNT)="Patient: "_PSJPTSTR
SET PSJLNCNT=PSJLNCNT+1
+15 SET PADEDRG=$$DRGSTR(.PSJINP)
+16 SET ^TMP($JOB,"PSJPDRTR",PSJPGCNT,PSJLNCNT)="Item"_$SELECT(PADEDRG[",":"(s): ",1:": ")_PADEDRG
SET PSJLNCNT=PSJLNCNT+1
+17 SET USRSTR=$$USRSTR(.PSJINP)
+18 SET ^TMP($JOB,"PSJPDRTR",PSJPGCNT,PSJLNCNT)="User: "_USRSTR
SET PSJLNCNT=PSJLNCNT+1
+19 SET TRANSTR=$$TRANSTR^PSJPDRIP(.PSJINP)
+20 SET ^TMP($JOB,"PSJPDRTR",PSJPGCNT,PSJLNCNT)="Transaction Type: "_TRANSTR
SET PSJLNCNT=PSJLNCNT+1
+21 SET OVRIDE=$SELECT($GET(PSJINP("PSJOVR")):"Y",1:"N")
+22 SET ^TMP($JOB,"PSJPDRTR",PSJPGCNT,PSJLNCNT)="Override Transactions Only?: "_OVRIDE
SET PSJLNCNT=PSJLNCNT+1
+23 SET ^TMP($JOB,"PSJPDRTR",PSJPGCNT,PSJLNCNT)=PSJDASH
SET PSJLNCNT=PSJLNCNT+1
+24 QUIT
+25 ;
PHEAD(PSJINP,PSJLNCNT,PSJPGCNT,PSJPGTOT,PSADDPG) ; Page header
+1 if $GET(PSJINP("PSJDELM"))="D"
QUIT
+2 NEW PSJDIV,PAD,LINE,PDASH,PSDIVOUT,PSDCNT,PSDIVSTR
+3 SET $PIECE(PDASH,"-",131)=""
+4 SET $PIECE(PAD," ",80)=""
+5 SET PSJLNCNT=0
+6 ; Don't increment page count when called from Report Header
+7 IF $GET(PSADDPG)
SET PSJPGCNT=$GET(PSJPGCNT)+1
+8 SET PSDIVSTR=$GET(PSJINP("PSJDIV"))
+9 IF PSDIVSTR'="ALL"
SET PSDIVSTR=""
SET PSJDIV=0
SET PSDCNT=0
FOR PSDCNT=0:1
SET PSJDIV=$ORDER(PSJINP("PSJDIV",PSJDIV))
if 'PSJDIV
QUIT
Begin DoDot:1
+10 SET PSDIVOUT=$PIECE($GET(^DG(40.8,+PSJDIV,0)),"^")
+11 SET PSDIVSTR=$SELECT(PSDCNT:PSDIVSTR_","_PSDIVOUT,1:PSDIVOUT)
End DoDot:1
+12 SET LINE="Run Date: "_$PIECE($TRANSLATE($$FMTE^XLFDT($$NOW^XLFDT,2),"@"," "),":",1,2)_$EXTRACT(PAD,1,25)_"PADE Transaction Report Summary"_$EXTRACT(PAD,1,30)_"Page "_PSJPGCNT_" of ^"
SET PSJLNCNT=PSJLNCNT+1
+13 SET ^TMP($JOB,"PSJPDRTR",PSJPGCNT,PSJLNCNT)=LINE
SET PSJLNCNT=PSJLNCNT+1
+14 SET LINE="Run By: "_$PIECE($GET(^VA(200,+$GET(DUZ),0)),"^")_$EXTRACT(PAD,1,20)_"Division: "_PSDIVSTR
+15 SET ^TMP($JOB,"PSJPDRTR",PSJPGCNT,PSJLNCNT)=LINE
SET PSJLNCNT=PSJLNCNT+1
+16 IF $GET(PSADDPG)
SET ^TMP($JOB,"PSJPDRTR",PSJPGCNT,PSJLNCNT)=PDASH
SET PSJLNCNT=PSJLNCNT+1
+17 QUIT
EXIT ; Clean up.
+1 NEW PSJOB
+2 KILL ^TMP($JOB,"PSJPDRTR"),^TMP($JOB,"TSCREEN")
+3 FOR PSJOB=$JOB,+$GET(ZTSK)
KILL ^TMP(PSJOB,"PSJPAT")
+4 KILL ZTSK
+5 QUIT
+6 ;
POCKDRG(PSJPSYS,PSJCAB,DRUG,DRWPCK) ; Get Drawer.Pocket location of DRUG in PSJCAB cabinet
+1 NEW CABIEN,DRGIEN,DRWIEN,DRWNAM,PCKIEN,PCKNAM,ND,LOCNAM,I
+2 if '$GET(PSJPSYS)!'$GET(PSJCAB)!'$GET(PSJCAB)
QUIT
+3 SET CABIEN=$$FIND1^DIC(58.6011,","_PSJPSYS_",","MXQ",+$GET(PSJCAB),,,"ERR")
+4 SET DRWIEN=0
FOR
SET DRWIEN=$ORDER(^PS(58.601,PSJPSYS,"DEVICE",CABIEN,"DRAWER",DRWIEN))
if 'DRWIEN
QUIT
SET DRWNAM=$PIECE(^(DRWIEN,0),"^")
Begin DoDot:1
+5 SET PCKIEN=0
FOR
SET PCKIEN=$ORDER(^PS(58.601,PSJPSYS,"DEVICE",CABIEN,"DRAWER",DRWIEN,"SUB",PCKIEN))
if 'PCKIEN
QUIT
SET ND=^(PCKIEN,0)
IF $PIECE(ND,"^",5)=DRUG
Begin DoDot:2
+6 SET PCKNAM=DRWNAM_"_"_$PIECE(ND,"^",3)
+7 FOR I=1:1:$LENGTH(PCKNAM,"_")
if $PIECE(PCKNAM,"_",I)'="~~"
SET LOCNAM=$GET(LOCNAM)_$PIECE(PCKNAM,"_",I)_"_"
+8 if $EXTRACT(LOCNAM,$LENGTH(LOCNAM))="_"
SET LOCNAM=$EXTRACT(LOCNAM,1,$LENGTH(LOCNAM)-1)
+9 SET DRWPCK(DRUG,LOCNAM)=$PIECE(ND,"^",2)
End DoDot:2
End DoDot:1
+10 QUIT
+11 ;
PGTOT() ; Return calculated number of pages for this report
+1 NEW PGTOT
SET PGTOT=$ORDER(^TMP($JOB,"PSJPDRTR",999999),-1)
+2 QUIT PGTOT
+3 ;
CSCHED(PSJINP) ; Return string of CS Federal Schedules from array PSJINP("PSJCSUB",SCHEDULE)
+1 KILL CSCHED
NEW PSJTMP
+2 SET CSCHED=$GET(PSJINP("PSJCSUB"))
IF '(CSCHED="N")
SET CSCHED="CS ("
Begin DoDot:1
+3 SET PSJTMP=""
FOR
SET PSJTMP=$ORDER(PSJINP("PSJCSUB",PSJTMP))
if PSJTMP=""
QUIT
SET CSCHED=CSCHED_PSJTMP_","
+4 IF $EXTRACT(CSCHED,$LENGTH(CSCHED))=","
SET CSCHED=$EXTRACT(CSCHED,1,$LENGTH(CSCHED)-1)_")"
End DoDot:1
+5 QUIT CSCHED
+6 ;
CABSTR(PSJINP) ; Return string of PADE cabinets from array PSJINP("PADEV",CABINET)
+1 KILL CABSTR
NEW PSJTMP,PSJII
+2 IF $GET(PSJINP("PADEV"))="ALL"
QUIT "ALL"
+3 SET PSJTMP=""
FOR PSJII=0:1
SET PSJTMP=$ORDER(PSJINP("PADEV",PSJTMP))
if PSJTMP=""
QUIT
Begin DoDot:1
+4 SET CABSTR=$SELECT(PSJII:CABSTR_",",1:"")_PSJTMP
End DoDot:1
+5 QUIT CABSTR
+6 ;
DRGSTR(PSJINP) ; Return string of PADE drugs selected by user from PSJINP("PSDRG",DRUG IEN)
+1 NEW PADEDRG
+2 IF $GET(PSJINP("PSDRG"))="ALL"
QUIT "ALL"
+3 SET PADEDRG=""
SET PSJTMP=""
FOR PSJII=0:1
SET PSJTMP=$ORDER(PSJINP("PSDRG",PSJTMP))
if PSJTMP=""
QUIT
Begin DoDot:1
+4 IF $GET(PSJTMP)
IF $DATA(^PSDRUG(+PSJTMP))
SET PADEDRG=$SELECT(PSJII:(PADEDRG_","),1:"")_$PIECE($GET(^PSDRUG(+PSJTMP,0)),"^")
QUIT
+5 IF $EXTRACT(PSJTMP)="*"
SET PADEDRG=$SELECT(PSJII:(PADEDRG_","),1:"")_PSJTMP
End DoDot:1
+6 if $EXTRACT(PADEDRG,$LENGTH(PADEDRG))
SET PADEDRG=$EXTRACT(PADEDRG,1,$LENGTH(PADEDRG)=1)
+7 QUIT PADEDRG
+8 ;
PTSTR(PSJINP) ; Return string of patients selected by user from PSJINP("PSJPAT",DFN)
+1 NEW PSJTMP,PATSTR,PSJII,PSJDONE
+2 SET PATSTR=""
+3 IF $GET(^TMP($JOB,"PSJPAT"))="ALL"!($GET(^TMP($JOB,"PSJPAT"))="NONE")
QUIT $GET(^TMP($JOB,"PSJPAT"))
+4 SET PSJTMP=""
FOR PSJII=0:1
SET PSJTMP=$ORDER(^TMP($JOB,"PSJPAT",PSJTMP))
if PSJTMP=""!$GET(PSJDONE)
QUIT
Begin DoDot:1
+5 IF $LENGTH($GET(PATSTR))+$LENGTH(^TMP($JOB,"PSJPAT",PSJTMP))>250
SET PATSTR=PATSTR_">> more..."
SET PSJDONE=1
QUIT
+6 SET PATSTR=$SELECT(PSJII:(PATSTR_","),1:"")_^TMP($JOB,"PSJPAT",PSJTMP)
End DoDot:1
+7 QUIT PATSTR
+8 ;
USRSTR(PSJINP) ; Return string of Users selected by user from PSJINP("PSJUSER")
+1 NEW PSJTMP,USRSTR,PSJII,PSJDONE
+2 IF $GET(PSJINP("PSJUSER"))="ALL"
QUIT PSJINP("PSJUSER")
+3 SET PSJTMP=""
FOR PSJII=0:1
SET PSJTMP=$ORDER(PSJINP("PSJUSER",PSJTMP))
if PSJTMP=""!$GET(PSJDONE)
QUIT
Begin DoDot:1
+4 IF $LENGTH($GET(USRSTR))+PSJINP("PSJUSER",PSJTMP)>250
SET USRSTR=USRSTR_">> more..."
SET PSJDONE=1
QUIT
+5 SET USRSTR=$SELECT(PSJII:(USRSTR_","),1:"")_PSJINP("PSJUSER",PSJTMP)_" ("_PSJTMP_")"
End DoDot:1
+6 QUIT USRSTR
+7 ;
TSCREEN(PSJY,PSJINP) ; Screen PADE TRANSACTION file (#58.6) using user input criteria
+1 ;
+2 NEW PSJOK,PSJTDT,PSJPSYSE,PSJDIV,PSJBDT,PSJEDT,PSJCAB,PSJCSUB,PSJDRG,PSJSUM,PSJUSER,PSJTCAB,PSJDELM,PSJTPAT,PSJTADRG,PSJTADNM,PSJXPTNM,PSJOVQ
+3 NEW PSJTDT,PSJTCAB,PSJTDRUG,PSJTSUB,PSJPTYP,PSJPAT,PSJTNOD0,PSJTORD,PSJOVR,PSJTRANS,PSJTTRAN,PSJTUSR,PSJTNOD1,PSJPTFLG,PSJOB,PSJTNOD3,PSJTSYS
+4 SET PSJOK=1
+5 SET PSJTNOD0=$GET(^PS(58.6,+PSJY,0))
+6 SET PSJTNOD1=$GET(^PS(58.6,+PSJY,1))
+7 SET PSJTNOD3=$GET(^PS(58.6,+PSJY,3))
+8 SET PSJPSYSE=$GET(PSJINP("PSJPSYSE"))
+9 SET PSJTSYS=$PIECE(PSJTNOD1,"^",3)
+10 IF (PSJPSYSE'="")
IF (PSJTSYS'="")
if (PSJPSYSE'=PSJTSYS)
QUIT 0
+11 SET PSJDIV=$GET(PSJINP("PSJDIV"))
+12 SET PSJBDT=$GET(PSJINP("PSJBDT"))
+13 SET PSJEDT=$GET(PSJINP("PSJEDT"))
+14 MERGE PSJCAB=PSJINP("PADEV")
+15 MERGE PSJCSUB=PSJINP("PSJCSUB")
+16 MERGE PSJDRG=PSJINP("PSDRG")
+17 SET PSJSUM=$GET(PSJINP("PSJUM"))
+18 MERGE PSJUSER=PSJINP("PSJUSER")
+19 MERGE PSJTRANS=PSJINP("PSJTRANS")
+20 MERGE PSJPAT=PSJINP("PSJPAT")
+21 DO CNVTYP^PSJPDRIP(.PSJTRANS,.PSJPTYP)
+22 SET PSJDELM=$GET(PSJINP("PSJDELM"))
+23 SET PSJOVR=$GET(PSJINP("PSJOVR"))
+24 ; Transaction Date
+25 SET PSJTDT=$PIECE(PSJTNOD0,"^")
+26 IF PSJBDT>PSJTDT!(PSJEDT<PSJTDT)
QUIT 0
+27 ; PADE Device (Cabinet)
+28 SET PSJTCAB=$PIECE(PSJTNOD0,"^",2)
if PSJTCAB=""
QUIT 0
+29 IF '$DATA(PSJCAB(PSJTCAB))
QUIT 0
+30 ; Drug Item
+31 SET PSJTDRUG=$PIECE(PSJTNOD0,"^",3)
+32 ; Alternate Drug ID and Name
+33 SET PSJTADRG=$PIECE(PSJTNOD1,"^",7)
SET PSJTADNM=$PIECE(PSJTNOD1,"^",6)
+34 IF '($GET(PSJDRG)="ALL")
if PSJTDRUG=""&(PSJTADRG="")
QUIT 0
+35 IF '($GET(PSJDRG)="ALL")
IF '$DATA(PSJDRG(+PSJTDRUG))&'$DATA(PSJDRG("*"_PSJTADNM))
QUIT 0
+36 ; Controlled Substance Schedule
+37 SET PSJTSUB=$$GETCLASS^PSJPDRIN(PSJTDRUG)
+38 IF 'PSJTDRUG&$LENGTH($GET(PSJTADRG))
SET PSJTSUB=0
+39 if PSJTSUB=""
QUIT 0
+40 IF '$DATA(PSJCSUB(PSJTSUB))
QUIT 0
+41 ; Transaction Type
+42 SET PSJTTRAN=$PIECE(PSJTNOD0,"^",5)
if PSJTTRAN=""
QUIT 0
+43 IF '$DATA(PSJPTYP(PSJTTRAN))
QUIT 0
+44 ; Patient
+45 SET PSJTPAT=$PIECE(PSJTNOD0,"^",15)
SET PSJTPAT=$SELECT(PSJTPAT="":+PSJTPAT,1:PSJTPAT)
+46 IF 'PSJTPAT
SET PSJTPAT=$PIECE(PSJTNOD3,"^",7)
SET PSJTPAT=$SELECT(PSJTPAT="":+PSJTPAT,1:PSJTPAT)
+47 SET PSJXPTNM=$PIECE(PSJTNOD3,"^",4)
IF 'PSJTPAT&(PSJXPTNM]"")
SET PSJTPAT="*"
+48 SET PSJPTFLG=$$PTTRFLG^PSJPDRU1(.PSJINP)
+49 ; If only "NO PATIENT" selected, quit if patient in transaction
+50 SET PSJOB=$SELECT($GET(PSJINP("PSJTSK")):PSJINP("PSJTSK"),1:$JOB)
+51 IF PSJPTFLG=2
IF '$DATA(^TMP(PSJOB,"PSJPAT",PSJTPAT))
QUIT 0
+52 ; If not "NO PATIENT", and not "ALL" patients,
+53 IF 'PSJPTFLG
IF (PSJTPAT'="")
IF (PSJTPAT'=0)
QUIT 0
+54 ; User
+55 SET PSJTUSR=$PIECE($GET(^PS(58.6,+PSJY,5)),"^")
if PSJTUSR=""
QUIT 0
+56 IF ($GET(PSJUSER)'="ALL")&($DATA(PSJUSER)>1)&'$DATA(PSJUSER(PSJTUSR))
QUIT 0
+57 ; Overrides
+58 SET PSJTORD=$PIECE($GET(^PS(58.6,+PSJY,1)),"^")
+59 IF PSJOVR
Begin DoDot:1
+60 IF '$$PTRNSTYP^PSJPAD7I(PSJTTRAN)
SET PSJOVQ=1
QUIT
+61 IF (PSJTORD'="")&(PSJTORD'="OVERRIDE")
SET PSJOVQ=1
QUIT
End DoDot:1
if $GET(PSJOVQ)
QUIT 0
+62 QUIT 1
+63 ;
SETCOLS(PSJINP,COL) ; Report column widths
+1 SET COL(1)=0
SET COL(2)=15
SET COL(3)=26
SET COL(4)=30
SET COL(5)=38
SET COL(6)=46
SET COL(7)=53
SET COL(8)=84
SET COL(9)=108
+2 QUIT
+3 ;
SECTHD1() ; Sub-header line 1
+1 NEW STRING
+2 SET STRING="Transaction^Trans^^ Beg^^ End^^Transaction^Witnessed"
+3 QUIT STRING
+4 ;
SECTHD2() ; Sub-header line 2
+1 NEW STRING
+2 SET STRING="Date/Time^Type^O-R^ Bal^ Qty^ Bal^Patient^By^By"
+3 QUIT STRING
+4 ;
CONTRAN(PSLNHSTR,PSJPGCNT,PSJLNCNT,PSJINP) ; Print "Continued" message when listing spans multiple pages
+1 ; Don't output "Cont" text if delimited output
+2 if ($GET(PSJINP("PSJDELM"))="D")
QUIT
+3 IF PSJLNCNT>($GET(PSJIOSL)-6)
DO PHEAD(.PSJINP,.PSJLNCNT,.PSJPGCNT,.PSJPGTOT,1)
+4 SET ^TMP($JOB,"PSJPDRTR",PSJPGCNT,PSJLNCNT)=""
SET PSJLNCNT=PSJLNCNT+1
+5 SET ^TMP($JOB,"PSJPDRTR",PSJPGCNT,PSJLNCNT)=PSLNHSTR
SET PSJLNCNT=PSJLNCNT+1
+6 SET ^TMP($JOB,"PSJPDRTR",PSJPGCNT,PSJLNCNT)=""
SET PSJLNCNT=PSJLNCNT+1
+7 SET ^TMP($JOB,"PSJPDRTR",PSJPGCNT,PSJLNCNT)=$$SECTHD1^PSJPDRTP()
SET PSJLNCNT=PSJLNCNT+1
+8 SET ^TMP($JOB,"PSJPDRTR",PSJPGCNT,PSJLNCNT)=$$SECTHD2^PSJPDRTP()
SET PSJLNCNT=PSJLNCNT+1
+9 SET ^TMP($JOB,"PSJPDRTR",PSJPGCNT,PSJLNCNT)=PSJDASH
SET PSJLNCNT=PSJLNCNT+1
+10 QUIT
