Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PSJPDRIN

PSJPDRIN.m

Go to the documentation of this file.
  1. PSJPDRIN ;BIR/MV-MAIN DRIVER PADE INVENTORY REPORT ;11/15/2015
  1. ;;5.0;INPATIENT MEDICATIONS;**317,335**;16 DEC 97;Build 6
  1. ;
  1. ; Reference to ^PS(50.7 is supported by DBIA 2180.
  1. ; Reference to DATA^PSN50P68 is supported by DBIA 4545.
  1. ; Reference to DIC^PSSDI is supported by DBIA 4551.
  1. ; Reference to ^%ZTLOAD is supported by DBIA 10063.
  1. ; Reference to CLEAR^VALM1 is supported by DBIA 10116.
  1. ; Reference to EN^DDIOL is supported by DBIA 10142.
  1. ; Reference to ^%ZIS is supported by DBIA 10086.
  1. ;
  1. Q
  1. ;
  1. EN ; Main Entry point
  1. N PSJSTOP,PSDRG,PSJINP,DTOUT,DUOUT,DA,DIC,DR,DIR
  1. S PSJSTOP=0
  1. F Q:$G(PSJSTOP)<0 D ENLOOP
  1. Q
  1. ;
  1. ENLOOP ; Prompt loop
  1. N PSJINP,ZTSK,ZTDESC,ZTRTN,ZTSAVE
  1. S PSJSTOP=0
  1. D ASK(.PSJINP) G:PSJSTOP EXIT
  1. Q:$G(PSJINP("PSJDEV"))="Q"
  1. START ; Queued entry
  1. N PSJSTOP S PSJSTOP=0
  1. K ^TMP("PSJPDRIN",$J)
  1. D PROCESS(.PSJINP) G:PSJSTOP EXIT
  1. D EN^PSJPDRIP(.PSJINP)
  1. I $G(PSJINP("PSJDELM"))="D" D
  1. .N DIR,X,Y S DIR(0)="EA"
  1. .S DIR("A",1)=""
  1. .S DIR("A",2)="The delimited report is complete."
  1. .S DIR("A")="Please turn logging off, then press return to continue."
  1. .D ^DIR
  1. Q
  1. ;
  1. EXIT ; Clean up
  1. K ^TMP("PSJPDRIN",$J),ZTSK
  1. Q
  1. ;
  1. ASK(PSJINP) ;Prompt for selection criteria. Quit when PSJSTOP is true
  1. ;
  1. N PSJCSUB,PSJSYS,PSJDEV,PSJDIV,PADEV,PSJSUMM,PSJDELIM,PSJDRG,PSDRG
  1. D CLEAR^VALM1 W !!
  1. S PSJSTOP=0
  1. W ?20,"PADE On-Hand Inventory Report",!
  1. S PSJINP("PSJPSYS")=$$PSYS Q:PSJSTOP
  1. D DIV^PSJPDRIP(.PSJDIV,.PSJSTOP) Q:PSJSTOP M PSJINP("PSJDIV")=PSJDIV
  1. D PADEV(.PADEV,.PSJINP) Q:PSJSTOP M PSJINP("PADEV")=PADEV
  1. D PSJCSUB(.PSJINP,.PSJCSUB) Q:PSJSTOP M PSJINP("PSJCSUB")=PSJCSUB
  1. D DRUG(.PSDRG,.PSJINP) Q:PSJSTOP M PSJINP("PSDRG")=PSDRG
  1. S PSJINP("PSJSUM")=$$SUMM Q:PSJSTOP
  1. S PSJINP("PSJDELM")=$$DELIM Q:PSJSTOP
  1. S PSJINP("PSJDEV")=$$SELDEV(,.PSJINP) S:$G(DUOUT)!$G(DTOUT) PSJSTOP=1 Q:PSJSTOP
  1. Q
  1. ;
  1. PSYS() ; Get PADE Inventory System
  1. N PSYS
  1. S PSYS=$$PSYS^PSJPDRUT()
  1. Q PSYS
  1. ;
  1. DIV() ; Get Division
  1. N PSDIV,DIC,X,Y
  1. S DIC("S")="I $D(^PS(58.63,""D"",+Y))"
  1. S DIC=40.8,DIC(0)="QAE",DIC("A")="Select Division: " D ^DIC
  1. S PSDIV=$S(Y>0:+Y,1:"")
  1. I $G(DUOUT)!$G(DTOUT)!(PSDIV="") S PSJSTOP=1
  1. Q PSDIV
  1. ;
  1. PADEV(PADEV,PSJINP) ; Get PADE dispensing device(s), screen for Division and PADE Inventory System
  1. ;Requires PSJINP("PSJDIV"),PSJINP("PSJPSYS")
  1. N PADNAM,PADIEN,PADTMP
  1. D PADEV^PSJPDRTR(.PADEV,.PSJINP,1)
  1. Q:($D(PADEV)<10)
  1. M PADTMP=PADEV
  1. K PADEV
  1. S PADNAM=0 F S PADNAM=$O(PADTMP(PADNAM)) Q:PADNAM="" D
  1. .Q:'$G(PADTMP(PADNAM))
  1. .S PADEV(PADTMP(PADNAM))=PADNAM
  1. Q
  1. ;
  1. CAB(PSJINP,PADEV) ; Get PADE (cabinets)
  1. N PSCAB,DIC,X,Y,PSJDIV,PSJPSYS,PSJSCR,PSCABHLP,PSJX
  1. S PSJDIV=$G(PSJINP("PSJDIV"))
  1. S PSJPSYS=$G(PSJINP("PSJPSYS"))
  1. S PSCABHLP="Select one or more PADE Dispensing Devices, or enter '^ALL' to select all."
  1. S DIC("S")="I ($D(PSJINP(""PSJDIV"",+$G(^PS(58.63,+Y,2)))))&('$$EMPTY^PSJPADPT(+Y))"
  1. S DIC=58.63,DIC(0)="QABE",DIC("A")="Select PADE Dispensing Device: "_$S($D(PADEV)<10:"^ALL// ",1:"")
  1. S DIC("W")="N PSJPADST S PSJPADST=$P($G(^PS(58.63,+$G(Y),0)),""^"",4),PSJPADST=$S(PSJPADST=""I"":"" (INACTIVE)"",1:"""") W PSJPADST"
  1. D ^DIC S PSJX=X
  1. S:$E(PSJX)="^" Y=$$XALL^PSJPDRIP(PSJX)
  1. I X="",$D(PADEV)<10 S Y="ALL"
  1. S:Y=-1 Y=""
  1. S PSCAB=Y
  1. S:($G(DUOUT)&(PSCAB'="ALL"))!$G(DTOUT) PSJSTOP=1
  1. Q PSCAB
  1. ;
  1. PSJCSUB(PSJINP,PSJCSUB) ; Get Controlled Subs (CS) Schedules
  1. N DIR,X,Y,PSJDONE,SCHED,SCHLST
  1. K PSJCSUB
  1. W ! D EN^DDIOL(" Enter '^ALL' to select all Controlled substance")
  1. D EN^DDIOL(" schedules and all non-controlled substances.") W !
  1. S DIR("A")="Enter (C)S or (N)on-CS: ^ALL//",DIR(0)="SAO^C:Controlled Substances;N:Non-Controlled Substances;ALL:All CS Schedules and Non-CS"
  1. D ^DIR S:X="" Y="ALL"
  1. I $E(X)="^" S Y=$$XALL^PSJPDRIP(X)
  1. S PSJCSUB=Y
  1. I PSJCSUB'="ALL"&($G(DUOUT)!$G(DTOUT)!(Y="")) S PSJSTOP=1 Q
  1. S:PSJCSUB="N"!(PSJCSUB="ALL") PSJCSUB(0)="Unscheduled"
  1. Q:PSJCSUB="N"
  1. ; If YES to Controlled Subs, get CS Schedule
  1. S SCHLST="1:Schedule I;2:Schedule II;2n:Schedule II Non-Narcotics;3:Schedule III;3n:Schedule III Non-Narcotics;4:Schedule IV;5:Schedule V"
  1. I PSJCSUB="ALL" D ALLSCHED^PSJPDRIP(.PSJCSUB,SCHLST) S PSJCSUB="ALL" Q
  1. K PSJDONE,PSJCSUB
  1. N DIR,X,Y,SCNT
  1. F Q:$G(PSJSTOP)!$G(PSJDONE) D SELCSUB^PSJPDRTR(.PSJCSUB)
  1. Q
  1. ;
  1. DRUG(DRUG,PSJINP) ; Allow user to select appropriate subset of drug items
  1. N PSDONE,DIC,X,Y,GETDRG,LSTCNT,PSJCSUB,DRGARAY,PSJPSYS,PADEV,PSJDRC
  1. S PSJCSUB=$G(PSJINP("PSJCSUB"))
  1. S PSJPSYS=$G(PSJINP("PSJPSYS"))
  1. M PADEV=PSJINP("PADEV")
  1. D DRCAB(.PSJINP,.PSJDRC) ; Get drugs linked to cabinet(s)
  1. D DRUGSEL^PSJPDRTR(.PSJINP,.PSJDRC,.DRUG,,.PSJSTOP) ; Prompt for drug items
  1. Q
  1. ;
  1. SUMM() ; Prompt user for Detailed or Summary report
  1. N SUMM,DIR,X,Y
  1. S DIR(0)="S^D:Detailed Report;S:Summary Report"
  1. S DIR("A")="Select (D)etail or (S)ummary Report "
  1. S DIR("B")="S",DIR("?")="You may select 'D' for a detailed report or 'S' for a Summary report."
  1. D ^DIR S:$G(DUOUT)!$G(DTOUT) PSJSTOP=1
  1. Q Y
  1. ;
  1. DELIM() ; Prompt user for delimited output or formatted report.
  1. N DELIM,DIR,X,Y
  1. S DIR(0)="S^R:Report;D:Delimited Output"
  1. S DIR("A")="Select (R)eport or (D)elimited output "
  1. S DIR("B")="R",DIR("?")="You may select 'R' for a report or 'D' for CSV delimited output (for spreadsheet)"
  1. D ^DIR S:$G(DUOUT)!$G(DTOUT) PSJSTOP=1
  1. S DELIM=Y
  1. Q DELIM
  1. ;
  1. GETCLASS(DRGIEN) ; Get Controlled Substance Federal Schedule from VA PRODUCT FILE for DRUG FILE (#50) entry DRGIEN
  1. ; Input : pointer to DRUG (#50) file
  1. ; Output : Value from CS FEDERAL SCHEDULE field (#19) in VA PRODUCT (#50.68) file
  1. N PSJDPROD,PSJCLASS,PSJNDF S PSJCLASS=0
  1. Q:'$G(DRGIEN) "-1"
  1. K ^TMP($J,"PSJCLASS")
  1. S PSJNDF=$P($G(^PSDRUG(+DRGIEN,"ND")),"^",3) I '$G(PSJNDF) D Q PSJCLASS
  1. . N CS S CS=$P($G(^PSDRUG(+DRGIEN,0)),"^",3)
  1. . S PSJCLASS=$S(+CS>1&(+CS<6):+CS,1:0) I ((PSJCLASS=2)!(PSJCLASS=3))&(CS["C") S PSJCLASS=PSJCLASS_"n"
  1. D DATA^PSN50P68(PSJNDF,,"PSJCLASS")
  1. S PSJCLASS=$P($G(^TMP($J,"PSJCLASS",+PSJNDF,19)),"^")
  1. S PSJCLASS=$S(PSJCLASS]"":PSJCLASS,1:0)
  1. K ^TMP($J,"PSJCLASS")
  1. Q PSJCLASS
  1. ;
  1. LISTDRG(SCREEN,DRGARAY) ; Get list of drugs from drug file screened by SCREEN, outpat DRGARAY
  1. K DRGARAY
  1. N DIC,X,Y
  1. D LIST^DIC(50,,,"P",,,,,SCREEN,,"DRGARAY")
  1. Q
  1. ;
  1. PROCESS(PSJINP) ; Gather report data, store in ^TMP
  1. I PSJINP("PSJSUM")="S" D PROCSUM(.PSJINP) Q
  1. I PSJINP("PSJSUM")'="S" D PROCDET(.PSJINP)
  1. Q
  1. ;
  1. PROCSUM(PSJINP) ; Gather SUMMARY report data
  1. N PSJCAB,PSJDRG,CC,LNCNT,TABMAR,PSJPSYS,PSJCABNM,PSJQTY,PSJDFORM,PSJII,PSJOI,PSJDFIEN,PSJCABST,PSJDRGX,PSJDNAM
  1. S PSJINP("PSPGTOT")=1,LNCNT=1
  1. S $P(TABMAR," ",40)=" "
  1. S PSJPSYS=+PSJINP("PSJPSYS")
  1. M PSJCAB=PSJINP("PADEV")
  1. M PSJDRG=PSJINP("PSDRG")
  1. S PSJCAB=0 F CC=0:1 S PSJCAB=$O(PSJCAB(PSJCAB)) Q:'PSJCAB D
  1. .S PSJCABNM=$P($G(^PS(58.63,PSJCAB,0)),"^"),PSJCABST=$P($G(^PS(58.63,PSJCAB,0)),"^",4),PSJCABST=$S(PSJCABST="I":"(I)",1:"")
  1. .N PSJDRGX D ALPHADRG(PSJPSYS,PSJCAB,.PSJDRG,.PSJDRGX)
  1. .I PSJINP("PSJDELM")="R" D
  1. ..Q:'$D(PSJDRGX)
  1. ..I $G(CC) S ^TMP("PSJPDRIN",$J,LNCNT)="^",LNCNT=LNCNT+1
  1. ..S ^TMP("PSJPDRIN",$J,LNCNT)=PSJCABNM_PSJCABST,LNCNT=LNCNT+1
  1. .S PSJDNAM="" F PSJII=1:1 S PSJDNAM=$O(PSJDRGX(PSJDNAM)) Q:PSJDNAM="" S PSJDRG=0 S PSJDRG=$O(PSJDRGX(PSJDNAM,PSJDRG)) Q:'PSJDRG D
  1. ..S PSJCABNM=$S(PSJINP("PSJDELM")="D":PSJCABNM,1:"")
  1. ..S PSJQTY=$$QTY(PSJPSYS,PSJCAB,PSJDRG)
  1. ..S PSJOI=+$G(^PSDRUG(PSJDRG,2))
  1. ..S PSJDFORM=$E($$DFORM(PSJPSYS,PSJCAB,PSJDRG),1,11)
  1. ..I PSJDFORM="" S PSJDFIEN=$P($G(^PS(50.7,PSJOI,0)),"^",2) I PSJDFIEN D
  1. ...N X,Y,DIC
  1. ...S DIC(0)="XN",DIC="^PS(50.606,",X=+PSJDFIEN
  1. ...D DIC^PSSDI(50.606,"PSJ",.DIC,.X)
  1. ...S PSJDFORM=$P($G(Y),"^",2)
  1. ..S ^TMP("PSJPDRIN",$J,LNCNT)=PSJCABNM_"^"_PSJDNAM_" ("_PSJDRG_")"_"^"_PSJDFORM_"^"_$S(PSJINP("PSJDELM")="R":$J(PSJQTY,4),1:PSJQTY),LNCNT=LNCNT+1
  1. Q
  1. ;
  1. PROCDET(PSJINP) ; Gather DETAIL report data
  1. N PSJCAB,PSJDRG,CC,LNCNT,TABMAR,PSJPSYS,PSJCABNM,DRGTOT,QTY,PSJDFORM,PSJOI,PSJII,QTY,PSJCOL,PCKNAM
  1. N PSJDFIEN,PSJDRNAM,PSJDRIEN,DRCNTOT
  1. S PSJINP("PSPGTOT")=1,LNCNT=1
  1. S $P(TABMAR," ",40)=" "
  1. S PSJPSYS=+PSJINP("PSJPSYS")
  1. M PSJCAB=PSJINP("PADEV")
  1. M PSJDRG=PSJINP("PSDRG")
  1. D SETCOLS^PSJPDRIP(.PSJINP,.PSJCOL)
  1. S PSJDRIEN=0 F S PSJDRIEN=$O(PSJDRG(PSJDRIEN)) Q:'PSJDRIEN S PSJDRNAM=$P(PSJDRG(PSJDRIEN),"^") D
  1. .S PSJDRNAM(PSJDRNAM_"^"_PSJDRIEN)=""
  1. S PSJDRNAM="" F S PSJDRNAM=$O(PSJDRNAM(PSJDRNAM)) Q:PSJDRNAM="" D
  1. .S PSJDRG=$P(PSJDRNAM,"^",2)
  1. .N DRWPCK,PSBFLAG
  1. .S:PSJINP("PSJDELM")="R" ^TMP("PSJPDRIN",$J,LNCNT)=" ^ ",LNCNT=LNCNT+1
  1. .S DRGTOT=0,DRCNTOT=0
  1. .S PSBFLAG=0 ; If a Patient Specific Bin is included in the list, set flag
  1. .S PSJCAB=0 F S PSJCAB=$O(PSJCAB(PSJCAB)) Q:'PSJCAB I $D(^PS(58.601,"DEV",PSJCAB,PSJDRG)) D
  1. ..N PSDRGLEN,PSJCABST,DRWPCK
  1. ..S PSJCABST=$P($G(^PS(58.63,PSJCAB,0)),"^",4),PSJCABST=$S(PSJCABST="I":"(I)",1:"")
  1. ..S PSJCABNM=$P($G(^PS(58.63,PSJCAB,0)),"^")_PSJCABST
  1. ..S PSJQTY=$$QTY(PSJPSYS,PSJCAB,PSJDRG)
  1. ..S DRGTOT=$G(DRGTOT)+PSJQTY
  1. ..S PSJOI=+$G(^PSDRUG(PSJDRG,2))
  1. ..S PSJDFIEN=$P($G(^PS(50.7,PSJOI,0)),"^",2)
  1. ..S PSJDFORM=$$DFORM(PSJPSYS,PSJCAB,PSJDRG)
  1. ..I PSJDFORM="" S PSJDFIEN=$P($G(^PS(50.7,PSJOI,0)),"^",2) I PSJDFIEN D
  1. ...N X,Y,DIC
  1. ...S DIC(0)="XN",DIC="^PS(50.606,",X=+PSJDFIEN
  1. ...D DIC^PSSDI(50.606,"PSJ",.DIC,.X)
  1. ...S PSJDFORM=$P($G(Y),"^",2)
  1. ..D POCKDRG^PSJPDRIP(PSJPSYS,PSJCAB,PSJDRG,.DRWPCK)
  1. ..N CC D Q
  1. ...S PCKNAM="" F CC=1:1 S PCKNAM=$O(DRWPCK(PSJDRG,PCKNAM)) Q:PCKNAM="" D
  1. ....N QTY,FMTQTY S QTY=+DRWPCK(PSJDRG,PCKNAM)
  1. ....S DRCNTOT=$G(DRCNTOT)+QTY ; *Requires individual pocket balances for multi-pocket drugs*
  1. ....N PSJDTRUN ; Handle max length drug names
  1. ....S PSJDTRUN=$P($G(^PSDRUG(PSJDRG,0)),"^")
  1. ....I $L(PSJDTRUN)>33 S PSJDTRUN=$E(PSJDTRUN,1,33)
  1. ....S PSJDTRUN=PSJDTRUN_"("_PSJDRG_")"
  1. ....S FMTQTY=$S(PCKNAM["PSB":"*"_QTY,$E(PCKNAM,$L(PCKNAM)-1,$L(PCKNAM))="RB":"*"_QTY,1:QTY)
  1. ....I FMTQTY["*" D
  1. .....S PSBFLAG("PSB")=$S($E(PCKNAM,$L(PCKNAM)-2,$L(PCKNAM))["PSB":1,1:$G(PSBFLAG("PSB")))
  1. .....S PSBFLAG("RB")=$S($E(PCKNAM,$L(PCKNAM)-1,$L(PCKNAM))["RB":1,1:$G(PSBFLAG("RB")))
  1. ....S ^TMP("PSJPDRIN",$J,LNCNT)=PSJDTRUN_"^"_PSJDFORM_"^"_$S(PSJINP("PSJDELM")="R":$J(FMTQTY,4),1:FMTQTY)_"^"_PSJCABNM_"^"_PCKNAM,LNCNT=LNCNT+1
  1. ...I CC=1 N QTY,PSCABIEN,PSDRGIEN S PSCABIEN=$O(^PS(58.601,PSJPSYS,"DEVICE","B",PSJCAB,"")) D
  1. ....S QTY="-" I PSCABIEN S PSDRGIEN=$O(^PS(58.601,PSJPSYS,"DEVICE",PSCABIEN,"DRUG","B",PSJDRG,""))
  1. ....N PSJDTRUN ; Handle max length drug names
  1. ....S PSJDTRUN=$P($G(^PSDRUG(PSJDRG,0)),"^")
  1. ....I $L(PSJDTRUN)>33 S PSJDTRUN=$E(PSJDTRUN,1,33) S:$E(PSJDTRUN,$L(PSJDTRUN))=" " PSJDTRUN=$E(PSJDTRUN,1,$L(PSJDTRUN)-1)
  1. ....S PSJDTRUN=PSJDTRUN_" ("_PSJDRG_")"
  1. ....S ^TMP("PSJPDRIN",$J,LNCNT)=PSJDTRUN_"^"_PSJDFORM_"^"_$S(PSJINP("PSJDELM")="R":$J(QTY,4),1:QTY)_"^"_PSJCABNM_"^UNK",LNCNT=LNCNT+1
  1. .I PSJINP("PSJDELM")="R" D
  1. ..S ^TMP("PSJPDRIN",$J,LNCNT)=$E(TABMAR,1,34)_"^^----",LNCNT=LNCNT+1
  1. ..S ^TMP("PSJPDRIN",$J,LNCNT)=$E(TABMAR,1,34)_"^SUB TOTAL:^"_$J(DRCNTOT,4),LNCNT=$G(LNCNT)+1
  1. ..S ^TMP("PSJPDRIN",$J,LNCNT)=$E(TABMAR,1,24)_" REPORTED CABINET"_"^ TOTAL:^"_$J(DRGTOT,4),LNCNT=$G(LNCNT)+1
  1. ..I $G(PSBFLAG("PSB")) S ^TMP("PSJPDRIN",$J,LNCNT)="* Patient Specific Bin counts not included in Reported Cabinet Total.",LNCNT=$G(LNCNT)+1
  1. ..I $G(PSBFLAG("RB")) S ^TMP("PSJPDRIN",$J,LNCNT)="* Return Bin counts not included in Reported Cabinet Total.",LNCNT=$G(LNCNT)+1
  1. Q
  1. ;
  1. QTY(SYS,PSJCAB,PSJDRG) ; Return quantity of drug PSJDRG in cabinet PSJCAB
  1. N QTY,PSYSIEN,PDEVIEN,PDRGIEN
  1. S PSYSIEN=$O(^PS(58.601,"DEV",PSJCAB,PSJDRG,""))
  1. S PDEVIEN=$O(^PS(58.601,"DEV",PSJCAB,PSJDRG,PSYSIEN,""))
  1. S PDRGIEN=$O(^PS(58.601,"DEV",PSJCAB,PSJDRG,PSYSIEN,PDEVIEN,""))
  1. S QTY=+$P($G(^PS(58.601,PSYSIEN,"DEVICE",PDEVIEN,"DRUG",PDRGIEN,0)),"^",3)
  1. Q QTY
  1. ;
  1. DFORM(SYS,PSJCAB,PSJDRG) ; Return Dose Form of drug PSJDRG in cabinet PSJCAB
  1. N FORM,PSYSIEN,PDEVIEN,PDRGIEN
  1. S PSYSIEN=$O(^PS(58.601,"DEV",PSJCAB,PSJDRG,""))
  1. S PDEVIEN=$O(^PS(58.601,"DEV",PSJCAB,PSJDRG,PSYSIEN,""))
  1. S PDRGIEN=$O(^PS(58.601,"DEV",PSJCAB,PSJDRG,PSYSIEN,PDEVIEN,""))
  1. S FORM=$P($G(^PS(58.601,PSYSIEN,"DEVICE",PDEVIEN,"DRUG",PDRGIEN,0)),"^",5)
  1. Q FORM
  1. ;
  1. DRCAB(PSJINP,PSJDRCAB) ; Return list of drugs in each cabinet in PSJINP("PADEV")
  1. ; Input = PSJINP("PADEV",CABINET IEN) - Cabinet IEN points to PADE DISPENSING DEVICE file 58.63
  1. ; Output = PSJDRCAB(DRUG IEN) - Drug IEN points to DRUG file 50
  1. K PSJDRCAB
  1. N CAB,CABDA,PSJPSYS,DRGDA,DRG
  1. S PSJPSYS=$G(PSJINP("PSJPSYS"))
  1. M CAB=PSJINP("PADEV")
  1. S CAB=0 F S CAB=$O(CAB(CAB)) Q:'CAB S CABDA=$O(^PS(58.601,PSJPSYS,"DEVICE","B",CAB,0)) I CABDA D
  1. .S DRGDA=0 F S DRGDA=$O(^PS(58.601,PSJPSYS,"DEVICE",CABDA,"DRUG",DRGDA)) Q:'DRGDA S DRG=+$G(^(DRGDA,0)) I DRG D
  1. ..Q:$D(PSJDRCAB(DRG))
  1. ..I '($G(PSJINP("PSJCSUB"))="ALL") Q:'$D(PSJINP("PSJCSUB",$$GETCLASS(DRG)))
  1. ..S PSJDRCAB(DRG)=$P($G(^PSDRUG(+$G(DRG),0)),"^")
  1. Q
  1. ;
  1. LISTALL(DRGLIST) ; Write list of drugs in DRGLIST("IEN",DRUG IEN)
  1. N II,DRGNAME,DRGIEN,TAB
  1. S $P(TAB," ",80)=""
  1. S DRGIEN=0 F S DRGIEN=$O(DRGLIST("IEN",DRGIEN)) Q:'DRGIEN D
  1. .W !,$E(TAB,1,8-$L(DRGIEN))_DRGIEN_" "_DRGLIST("IEN",DRGIEN)
  1. Q
  1. ;
  1. DRUGLIST(PSJINP,DRGLIST) ; Return DRGLIST array with "IEN" and "NAME" cross referenced
  1. N I,DRG,DLST
  1. S DRG=0 F I=1:1 S DRG=$O(DRGLIST(DRG)) Q:'DRG D
  1. .N DRGNAME S DRGNAME=$G(DRGLIST(DRG))
  1. .S DRGLIST("IEN",DRG)=DRGNAME
  1. .S DRGLIST("NAME",DRGNAME)=DRG
  1. Q
  1. ;
  1. SELDEV(RTN,PSJINP,PSJWIDE,ZTSK) ; Select Device
  1. ;
  1. N PSJDONE
  1. ;
  1. I $G(PSJINP("PSJDELM"))="D" D
  1. .N DIR,X,Y
  1. .S DIR("A",1)=""
  1. .S DIR("A",2)=" ************************************************************"
  1. .S DIR("A",3)=" ** You selected a Delimited report. Please verify you **"
  1. .S DIR("A",4)=" ** you have turned logging on to capture the output. **"
  1. .S DIR("A",5)=" ** **"
  1. .S DIR("A",6)=" ** To avoid undesired wrapping, please enter '0;512;999' **"
  1. .S DIR("A",7)=" ** at the 'DEVICE:' prompt. You may need to set your **"
  1. .S DIR("A",8)=" ** Terminal Session display settings to 512 columns. **"
  1. .S DIR("A",9)=" ************************************************************"
  1. .S DIR("A",10)=""
  1. .S DIR("A",11)="",DIR("A",12)=""
  1. .S DIR("A")=" Press return to continue"
  1. .S DIR(0)="EA" D ^DIR W !
  1. ;
  1. W !,"This report is designed for a "_$S($G(PSJWIDE):132,1:80)_" column format."
  1. W !,"You may queue this report to print at a later time.",!
  1. F Q:$G(PSJSTOP)!$G(PSJDONE) D
  1. .K %ZIS,IOP,POP,ZTSK N I S PSJION=$I,%ZIS="QM"
  1. .D ^%ZIS K %ZIS
  1. .I POP S IOP=PSJION D ^%ZIS K IOP,PSJION D Q
  1. ..N DIR,X,Y
  1. ..S DIR(0)="YA",DIR("A",1)=" ** No Device Selected **",DIR("A")="Select a different device? (Y/N) " D ^DIR
  1. ..S:'Y PSJSTOP=1
  1. .S PSJDONE=1
  1. ;
  1. K PSJION I $D(IO("Q")) D Q "Q"
  1. .S ZTDESC="PADE Inventory Report",ZTRTN=$S($G(RTN)]"":$G(RTN),1:"START^PSJPDRIN")
  1. .F I="PSJINP(","IO" S ZTSAVE(I)=""
  1. .K IO("Q") D ^%ZTLOAD W:$D(ZTSK) !,"Report is Queued to print!"
  1. Q ""
  1. ;
  1. CONT(PGCNT,PSJQUIT,TMPLN) ; Press return to continue
  1. N DIR
  1. I ($E($G(IOST))="C") W ! D
  1. .S:'$D(DIR("A")) DIR("A")="Press Return to continue or '^' to exit"
  1. .S DIR(0)="FO"
  1. .D ^DIR K DIR
  1. .I $G(DTOUT)!$G(DUOUT) S PSJSTOP=1
  1. Q
  1. ;
  1. ALPHADRG(SYS,CAB,DRG,DRGX) ; Alphabetize drug names DRGNAME in DRG(IEN)=DRGNAME, return in DRG(DRGNAME,IEN)=""
  1. N DRGIEN,DRGNAME
  1. S DRGIEN=0 F S DRGIEN=$O(DRG(DRGIEN)) Q:'DRGIEN S DRGNAME=$G(DRG(DRGIEN)) I DRGNAME]"" D
  1. .Q:'$D(^PS(58.601,"DEV",CAB,DRGIEN))
  1. .S DRGX(DRGNAME,DRGIEN)=""
  1. Q
  1. ;
  1. POCKET(PSJINP,PSDRG,OUTPOCK) ; Get pocket(s)
  1. ;
  1. N DRAWER,POCKET,DRGPCK,PSJPSYS,PADIEN,PADEV,DRGDEV,DRWIEN,DRGDRW,SUB,SUBID
  1. S PSJPSYS=$G(PSJINP("PSJPSYS")),PADEV=$G(PSJINP("PADEV"))
  1. S PADIEN=$O(^PS(58.601,+PSJPSYS,"DEVICE","B",+PADEV,""))
  1. Q:'$G(PSDRG)!'$G(PSJPSYS)!'$G(PADIEN)
  1. ;
  1. S OUTPOCK=PSDRG
  1. S DRWIEN=0 F S DRWIEN=$O(^PS(58.601,+PSJPSYS,"DEVICE",+PADIEN,"DRAWER",DRWIEN)) Q:'DRWIEN D
  1. .S SUB=0 F S SUB=$O(^PS(58.601,PSJPSYS,"DEVICE",PADIEN,"DRAWER",DRWIEN,"SUB",SUB)) Q:'SUB D
  1. ..S DRGPCK=$P(^PS(58.601,PSJPSYS,"DEVICE",PADIEN,"DRAWER",DRWIEN,"SUB",SUB,0),"^",5),POCKET=$P(^(0),"^",3),SUBID=$P($G(^(0)),"^",4)
  1. ..Q:'(DRGPCK=$G(PSDRG))
  1. ..S DRAWER=$G(^PS(58.601,+PSJPSYS,"DEVICE",+PADIEN,"DRAWER",DRWIEN,0))
  1. ..S:DRAWER="" DRAWER="~~"
  1. ..S POCKET=DRAWER_"_"_POCKET
  1. ..S DRGDRW=$O(^PS(58.601,PSJPSYS,"DEVICE",PADIEN,"DRAWER",DRWIEN,"DRUG","B",PSDRG,""))
  1. ..S OUTPOCK(DRGPCK,DRWIEN,SUB)=POCKET_"^"_DRGDRW_"^"_DRAWER_$S($L(SUBID):"^"_SUBID,1:"")
  1. S DRGDEV=$O(^PS(58.601,PSJPSYS,"DEVICE",PADIEN,"DRUG","B",PSDRG,""))
  1. S OUTPOCK(PSDRG,"DRGDEV")=DRGDEV
  1. Q