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

PSJPDRTR.m

Go to the documentation of this file.
  1. PSJPDRTR ;BIR/JH-MAIN DRIVER PADE TRANSACTION REPORT ;18 JUN 96 / 2:58 PM
  1. ;;5.0;INPATIENT MEDICATIONS;**317**;16 DEC 97;Build 130
  1. ;
  1. ; Reference to ^%DT is supported by DBIA 10003.
  1. ; Reference to CLEAR^VALM1 is supported by DBIA 10116.
  1. ; Reference to ^XLFDT is supported by DBIA 10103.
  1. ; Reference to ^DPT supported by DBIA 10035
  1. ; Reference to ^PSDRUG supported by DBIA 2192
  1. Q
  1. ;
  1. EN ; Main Entry point
  1. N PSJSTOP,PSDRG,PSJINP,DTOUT,DUOUT
  1. S PSJSTOP=0
  1. F Q:$G(PSJSTOP)<0 D ENLOOP
  1. Q
  1. ;
  1. ENLOOP ; Prompt loop
  1. N PSJINP,ZTSK,DIR,DIC,ZTSK,PSJTSK
  1. K ^TMP($J,"PSJPTLST"),^TMP($J,"PSJPAT")
  1. S PSJSTOP=0
  1. D ASK(.PSJINP) G:PSJSTOP EXIT
  1. Q:$G(PSJINP("PSJDEV"))="Q"
  1. START ; Queued entry
  1. N PSJSTOP,PSJDLRJ S PSJSTOP=0
  1. S PSJDLRJ=$J
  1. I $G(ZTSK) S (PSJDLRJ,PSJINP("PSJTSK"))=ZTSK
  1. K ^TMP($J,"PSJPDRTR"),^TMP($J,"TSCREEN")
  1. D PROCESS(.PSJINP) G:PSJSTOP EXIT
  1. D EN^PSJPDRTP(.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($J,"TSCREEN")
  1. K ^TMP($J,"PSJPDRTR")
  1. K ^TMP($J,"PSJPTLST")
  1. K ^TMP($J,"PSJPAT")
  1. Q
  1. ;
  1. ASK(PSJINP) ;Prompt for selection criteria. Quit if PSJSTOP is true
  1. N PSJCSUB,PSJSYS,PSJDEV,PSJDIV,PADEV,PSJSUMM,PSJDELIM,PSJDRG,PSDRG,PSJUSER,PSJTRANS,PSJOVR,PSJDONE,PSJSYSE,PSJPAT,PSJPSYSE,PSJTRX
  1. D CLEAR^VALM1 W !!
  1. S PSJSTOP=0
  1. W ?20,"PADE Transaction Report",!
  1. S PSJINP("PSJPSYS")=$$PSYS^PSJPDRIN() Q:PSJSTOP
  1. S PSJINP("PSJPSYSE")=$P($G(^PS(58.601,+$G(PSJINP("PSJPSYS")),0)),"^")
  1. D DIV^PSJPDRIP(.PSJDIV,.PSJSTOP) Q:PSJSTOP M PSJINP("PSJDIV")=PSJDIV
  1. S PSJINP("PSJBDT")=$$DATE^PSJPDRUT("B",.PSJSTOP) Q:PSJSTOP
  1. S PSJINP("PSJEDT")=$$DATE^PSJPDRUT("E",.PSJSTOP,.PSJINP) Q:PSJSTOP
  1. D PADEV(.PADEV,.PSJINP) Q:PSJSTOP M PSJINP("PADEV")=PADEV
  1. D PSJCSUB^PSJPDRIN(.PSJINP,.PSJCSUB) Q:PSJSTOP M PSJINP("PSJCSUB")=PSJCSUB
  1. D DRUG(.PSDRG,.PSJINP) Q:PSJSTOP M PSJINP("PSDRG")=PSDRG
  1. D PATIENT(.PSJINP,.PSJPAT) Q:PSJSTOP M PSJINP("PSJPAT")=PSJPAT M ^TMP($J,"PSJPAT")=^TMP($J,"PSJPTLST","SELPAT") K ^TMP($J,"PSJPTLST")
  1. D TRANS(.PSJINP,.PSJTRANS,.PSJOVR) Q:PSJSTOP M PSJINP("PSJTRANS")=PSJTRANS S PSJINP("PSJOVR")=$G(PSJOVR)
  1. D USER(.PSJINP,.PSJUSER) Q:PSJSTOP M PSJINP("PSJUSER")=PSJUSER
  1. S PSJINP("PSJDELM")=$$DELIM^PSJPDRIN Q:PSJSTOP
  1. S PSJINP("PSJDEV")=$$SELDEV^PSJPDRIN("START^PSJPDRTR",.PSJINP,1,.PSJTSK) D Q:PSJSTOP
  1. .I $G(PSJTSK) S PSJINP("PSJTSK")=PSJTSK M ^TMP(PSJTSK,"PSJPAT")=^TMP($J,"PSJPAT")
  1. .S:$G(DUOUT)!$G(DTOUT) PSJSTOP=1
  1. Q
  1. ;
  1. PADEV(PADEV,PSJINP,PSJ58601) ; Get list of PADE device(s)
  1. N PADE,PSJI,PSJPSYS,BDT,EDT,PADEDT,PSJDONE,PADEX,PSJPSYSI,PADEVTMP
  1. S BDT=$G(PSJINP("PSJBDT")),EDT=$G(PSJINP("PSJEDT"))
  1. S PSJPSYS=$P($G(^PS(58.601,+$G(PSJINP("PSJPSYS")),0)),"^")
  1. S PSJPSYSI=$G(PSJINP("PSJPSYS"))
  1. D PADELST(.PSJINP,.PADE,.PADEX,$G(PSJ58601))
  1. ;
  1. I $D(PADE)<10 D Q
  1. .S PSJSTOP=1
  1. .W !!,"PADE Dispensing Device: "
  1. .W !," No PADE dispensing device available for selection..",!
  1. .S DIR(0)="E" D ^DIR
  1. W ! D EN^DDIOL(" Enter '^ALL' to select all PADE dispensing devices.") W !
  1. S PSJPSYS=PSJPSYSI
  1. F Q:$G(PSJDONE)!$G(PSJSTOP) D SELPADE(.PADE,.PADEV,.PADEX,$G(PSJ58601))
  1. Q:$G(PSJSTOP)
  1. S PADE="" F S PADE=$O(PADEV(PADE)) Q:PADE="" D
  1. .N PADVALS S PADVALS(1)=PADE,PADVALS(2)=PSJPSYS
  1. .S PADEV(PADE)=$$FIND1^DIC(58.63,,"X",PADE)
  1. Q
  1. ;
  1. PADELST(PSJINP,PADE,PADEX,PSJ58601) ; Find selectable PADE devices for PADE Inbound System PSJPSYS
  1. ; and PADE transactions between PSJINP("PSJBDT") and PSJINP("EDT")
  1. ; INPUT: PSJINP("PSJPSYS")
  1. ; PSJINP("PSJBDT")
  1. ; PSJINP("PSJEDT")
  1. ; OUPUT: PADE(PADE NAME)=n
  1. ; PADE(n)=PADE NAME
  1. ;
  1. N PSJDIV,PSJHTM,PSJDOTS,PSPDIEN,PADETMP,PADETMPX,II
  1. S PSJHTM=$P($H,",",2),PSJDOTS=""
  1. S BDT=$G(PSJINP("PSJBDT")),EDT=$G(PSJINP("PSJEDT"))
  1. S PSJPSYS=$P($G(^PS(58.601,+$G(PSJINP("PSJPSYS")),0)),"^")
  1. S PSJPSYSI=$G(PSJINP("PSJPSYS"))
  1. S PSJI=1
  1. I '$G(PSJ58601) S PADE="" F S PADE=$O(^PS(58.6,"DEV",PSJPSYS,PADE)) Q:PADE="" D
  1. .Q:$D(PADE(PADE))
  1. .S PADEDT=BDT F S PADEDT=$O(^PS(58.6,"DEV",PSJPSYS,PADE,PADEDT)) Q:'PADEDT D
  1. ..D DISPDOTS^PSJPDRUT(.PSJHTM,.PSJDOTS,1)
  1. ..Q:PADEDT>EDT
  1. ..D PADELST2(.PSJINP,.PADE,.PADEX)
  1. I $G(PSJ58601) S PSPDIEN=0 F S PSPDIEN=$O(^PS(58.601,+PSJPSYSI,"DEVICE","B",PSPDIEN)) Q:'PSPDIEN D
  1. .S PADE=$P($G(^PS(58.63,+PSPDIEN,0)),"^")
  1. .Q:PADE=""!'$$DEVSCRN^PSJPDRUT(.PSJINP,PSPDIEN)
  1. .D PADELST2(.PSJINP,.PADE,.PADEX)
  1. I $D(PADEX)>1 N PADETMP,PADETMPX M PADETMP=PADE,PADETMPX=PADEX K PADE,PADEX D
  1. .N PADNAME,PADIEN
  1. .S PADNAME="" F II=1:1 S PADNAME=$O(PADETMP(PADNAME)) Q:PADNAME="" S PADE(PADNAME)=II,PADEX(II)=PADNAME
  1. Q
  1. ;
  1. PADELST2(PSJINP,PADE,PADEX) ; Continue building PADE device list
  1. Q:$D(PADE(PADE))
  1. N PADIEN,PADESTAT,PSJPSYS
  1. S PSJPSYS=PSJPSYSI
  1. S PADIEN=$$FIND1^DIC(58.63,,"O",PADE) I PADIEN S PADESTAT=$P($G(^PS(58.63,+PADIEN,0)),"^",4),PADESTAT=$S(PADESTAT="I":" (INACTIVE)",1:"")
  1. K PSJDIV D GETS^DIQ(58.63,PADIEN,"2","I","PSJDIV")
  1. S PSJDIV=+$G(PSJDIV("58.63",PADIEN_",",2,"I"))
  1. Q:'$D(PSJINP("PSJDIV",PSJDIV))
  1. S PADE(PADE)=PSJI
  1. S PADEX(PSJI)=PADE_"^"_$G(PADESTAT),PSJI=PSJI+1
  1. Q
  1. ;
  1. SELPADE(PADE,PADEV,PADEX,PS58601) ; Prompt for one PADE device (or ALL)
  1. N DIR,X,Y,DEVNAME,PSJY,PSJLSTA,PSFOUND,PADEUP,NOXREF
  1. N PSJPART,II,PSELMSG,PLSTMSG,PADXDATA,PSALLPC
  1. S PLSTMSG(1)="Transactions matching the entered Date Range and Division "
  1. S PLSTMSG(2)="exist for the PADE Dispensing devices listed below."
  1. S DIR(0)="FAO^1:30",DIR("?")="^D LIST^PSJPDRTR(.PADEX,.PLSTMSG,15,.PSJLSTA)"
  1. S DIR("A")="Select PADE Dispensing Device: "_$S($D(PADEV)>1:"",1:" ^ALL// ")
  1. D ^DIR
  1. I X="",($D(PADEV)<10) S Y="ALL"
  1. I $E(X)="^" S Y=$$XALL^PSJPDRIP(X)
  1. I $G(DUOUT)!$G(DTOUT) S PSJSTOP=1 Q
  1. I Y="ALL" M PADEV=PADE S PADEV="ALL",PSJDONE=1 Q
  1. I Y="" D Q
  1. .I $D(PADEV)>1 S PSJDONE=1 Q
  1. .W !!?2,"Select a single Item, several Items or enter ^ALL to select all Items."
  1. S PSJY=Y
  1. D PADEUP^PSJPDRUT(.PADE,.PADEUP)
  1. I $D(PADE(PSJY))&$$UNIQUE^PSJPDRUT(PSJY,.PADE) D Q
  1. .W " ",PSJY,$P($G(PADEX(PADE(PSJY))),"^",2) S PADEV(PSJY)=""
  1. I $D(PADEUP($$UPPER^HLFNC(PSJY)))&$$UNIQUE^PSJPDRUT($$UPPER^HLFNC(PSJY),.PADE) D Q:($P($G(PADXDATA),"^")]"")
  1. .S PADXDATA=$G(PADEX(PADEUP($$UPPER^HLFNC(PSJY))))
  1. .W " ",$P(PADXDATA,"^"),$P(PADXDATA,"^",2) I $P(PADXDATA,"^")]"" S PADEV($P(PADXDATA,"^"))=""
  1. ; If "?" list executed, check integers in PADEX list
  1. I $G(PSJLSTA) I $D(PADEX(PSJY)) D Q
  1. .N PADENAME S PADENAME=$P($G(PADEX(PSJY)),"^") I PADENAME="" W " ???" Q ; Null cabinet/device name? (impossible?!?!)
  1. .W " ",$P($G(PADEX(PSJY)),"^") S PADEV(PADENAME)=""
  1. S PSELMSG="Select a PADE device"
  1. S NOXREF=1,PSALLPC=1 ; don't use cross refs, return all data from partial lookup
  1. D PARTIAL^PSJPADPT(PSJY,.PADE,.PADEV,,PSELMSG,.PADEX,.PSFOUND,NOXREF,PSALLPC)
  1. Q:$G(PSFOUND)
  1. W " ?? (No match found)"
  1. Q
  1. ;
  1. SELCSUB(PSJCSUB) ; Prompt for one controlled subs schedule or (ALL)
  1. N X,Y,SCHED,SCHLST,SCNT,I,PSJPAD,PSJTMP
  1. S $P(PSJPAD," ",80)=""
  1. W ! D EN^DDIOL(" Enter '^ALL' to select all Controlled substance schedules.") W !
  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;ALL:All CS Schedules"
  1. F I=1:1:$L(SCHLST,";") S PSJTMP=$L($P($P(SCHLST,";",I),":")) D
  1. .S DIR("A",I)=$E(PSJPAD,1,12-PSJTMP)_$P($P(SCHLST,";",I),":",1)_$E(PSJPAD,1,6)_$P($P(SCHLST,";",I),":",2)
  1. S DIR(0)="SAO^"_SCHLST
  1. S DIR("A")="Select CS Schedule: "_$S($D(PSJCSUB)<10:"^ALL//",1:"")
  1. D ^DIR I X="",$D(PSJCSUB)<10 S Y="ALL"
  1. I $E(X)="^" S Y=$$XALL^PSJPDRIP(X)
  1. S SCHED=Y
  1. I $G(DUOUT)!$G(DTOUT) S PSJSTOP=1 Q
  1. I SCHED="ALL" D ALLSCHED^PSJPDRIP(.PSJCSUB,SCHLST) S PSJCSUB="CS (ALL)",PSJDONE=1 Q
  1. I SCHED="" D Q
  1. .I $D(PSJCSUB)>1 S PSJDONE=1 Q
  1. .W " Select a CS Schedule"
  1. S PSJCSUB(SCHED)=""
  1. Q
  1. ;
  1. DRUG(DRUG,PSJINP) ; Allow user to select appropriate subset of drug items
  1. N PSDONE,DIC,X,Y,GETDRG,LSTCNT,DRGARAY,PSJPSYS,PADEV,PSJDRC
  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 fo drug item, allow drugs not on file
  1. Q
  1. ;
  1. DRCAB(PSJINP,PSJDRCAB) ; Return list of drugs in each cabinet in PSJINP("PADEV")
  1. ; Input = PSJINP("PADEV",CABINET NAME) - 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,DRGDT,BDT,EDT,PSJPSYSE,PSDRGIEN,PSJHTM,PSJDOTS
  1. S PSJHTM=$P($H,",",2),PSJDOTS=""
  1. S PSJPSYS=$G(PSJINP("PSJPSYS"))
  1. S PSJPSYSE=$G(PSJINP("PSJPSYSE"))
  1. I PSJPSYSE="" S PSJPSYSE=$P($G(^PS(58.601,+PSJPSYS,0)),"^"),PSJINP("PSJPSYSE")=PSJPSYSE
  1. S BDT=$G(PSJINP("PSJBDT")),EDT=$G(PSJINP("PSJEDT"))
  1. M CAB=PSJINP("PADEV")
  1. S CAB="" F S CAB=$O(CAB(CAB)) Q:CAB="" D
  1. .S DRG=0 F S DRG=$O(^PS(58.6,"DEVD",PSJPSYSE,CAB,DRG)) Q:'DRG D
  1. ..D DISPDOTS^PSJPDRUT(.PSJHTM,.PSJDOTS,1)
  1. ..Q:$D(PSJDRCAB(DRG))
  1. ..I '($G(PSJINP("PSJCSUB"))="ALL") Q:'$D(PSJINP("PSJCSUB",$$GETCLASS^PSJPDRIN(DRG)))
  1. ..S DRGDT=$O(^PS(58.6,"DEVD",PSJPSYSE,CAB,DRG,BDT))
  1. ..Q:'DRGDT!(DRGDT>EDT)
  1. ..S PSJDRCAB(DRG)=$P($G(^PSDRUG(+DRG,0)),"^")
  1. S CAB="" F S CAB=$O(CAB(CAB)) Q:CAB="" D
  1. .S DRG=0 F S DRG=$O(^PS(58.6,"MDRG",PSJPSYSE,CAB,DRG)) Q:DRG="" D
  1. ..Q:$D(PSJDRCAB("*"_+DRG))
  1. ..S DRGDT=$O(^PS(58.6,"MDRG",PSJPSYSE,CAB,DRG,BDT))
  1. ..Q:'DRGDT!(DRGDT>EDT)
  1. ..N PSTRANS,PSALTID
  1. ..S PSTRANS=+$O(^PS(58.6,"MDRG",PSJPSYSE,CAB,DRG,DRGDT,""))
  1. ..Q:'PSTRANS
  1. ..S PSDRGIEN=$P($G(^PS(58.6,+PSTRANS,0)),"^",3)
  1. ..Q:PSDRGIEN
  1. ..S PSALTID=$P($G(^PS(58.6,+PSTRANS,1)),"^",7)
  1. ..S PSJDRCAB("*"_DRG)=$G(PSALTID)
  1. Q
  1. ;
  1. DRUGSEL(PSJINP,INDRUG,OUTDRUG,DRWPCK,PSJSTOP) ; Select drug(s)
  1. N COUNT,PSJCNT,DIR,X,Y,PSJDONE,DRGLIST,DRGNAME,PSJY,DRGN,PSJTMP,SELDRG,PSFOUND,PSALLPC
  1. K DRWPCK
  1. M DRGLIST=INDRUG
  1. S COUNT=0,PSJDONE=0,OUTDRUG=""
  1. D DRUGLIST^PSJPDRIN(.PSJINP,.DRGLIST)
  1. I $D(DRGLIST)<10 D Q
  1. .S PSJSTOP=1
  1. .W !!,"Drug Item: "
  1. .W !," No Drug Items available for selection..",!
  1. .S DIR(0)="E" D ^DIR
  1. I '$G(PSJINP("MANUNLOD")) W ! D EN^DDIOL(" Enter '^ALL' to select all available drug items") W !
  1. F Q:$G(DUOUT)!$G(DTOUT)!$G(PSJDONE)!$G(PSJSTOP) D
  1. .N PSJPART,II
  1. .N DIR,X,Y,DUOUT
  1. .S DIR(0)="FOA",DIR("A")="Select Drug Item: "_$S($D(OUTDRUG)>1:"",$G(PSJINP("MANUNLOD")):"",1:"^ALL// ")
  1. .S DIR("?")="^D LIST^PSJPDRTR(.INDRUG,,15)"
  1. .D ^DIR I X=""&($D(OUTDRUG)<10)&'$G(PSJINP("MANUNLOD")) S Y="ALL"
  1. .I $E(X)="^" S Y=$$XALL^PSJPDRIP(X)
  1. .I $G(DUOUT)!$G(DTOUT) S PSJSTOP=1 Q
  1. .I Y="" D Q
  1. ..I $D(OUTDRUG)>1!$G(PSJINP("MANUNLOD")) S PSJDONE=1 Q
  1. ..W !!?2,"Select a single Item, several Items or enter ^ALL to select all Items."
  1. .S PSJY=Y
  1. .I PSJY="ALL" S OUTDRUG="ALL",PSJDONE=1 D Q
  1. ..I $G(PSJINP("MANUNLOD")) S DRWPCK="ALL" Q
  1. ..N DRGIEN S DRGIEN=0 F S DRGIEN=$O(INDRUG(DRGIEN)) Q:DRGIEN="" D
  1. ...S OUTDRUG(DRGIEN)=$S(DRGIEN["*":$P(DRGIEN,"*",2),1:$P($G(^PSDRUG(+DRGIEN,0)),"^"))
  1. .I $D(DRGLIST("IEN",+PSJY)) D Q
  1. ..W " ",DRGLIST("IEN",+PSJY)
  1. ..S OUTDRUG(+PSJY)=$P($G(^PSDRUG(+PSJY,0)),"^")
  1. ..I $G(PSJINP("MANUNLOD")) D POCKET^PSJPDRIN(.PSJINP,+PSJY,.DRWPCK) S PSJDONE=1
  1. .S PSALLPC=0 ; don't return all data pieces from partial lookup
  1. .D PARTIAL^PSJPADPT(.PSJY,.DRGLIST,.SELDRG,1,,,.PSFOUND,,PSALLPC)
  1. .M OUTDRUG=SELDRG
  1. .I $G(PSJINP("MANUNLOD")) D Q
  1. ..S PSJY=$O(SELDRG(0))
  1. ..I $G(PSJY) D POCKET^PSJPDRIN(.PSJINP,+PSJY,.DRWPCK) S PSJDONE=1 Q
  1. ..W " ??"
  1. .I '$G(PSFOUND) W " ?? (No match found)" S PSJDONE=0
  1. Q
  1. ;
  1. PATIENT(PSJINP,SELPAT) ; Get list of patients
  1. D PATIENT^PSJPDRU1(.PSJINP)
  1. Q
  1. ;
  1. USER(PSJINP,PSJUSER) ; Get Vista Users (e.g., nurses) involved in PADE transactions
  1. N PSJDONE,USER,USERX,SELUSER K PSJUSER
  1. D USERLIST^PSJPDRUT(.PSJINP,.USER,.USERX)
  1. ;
  1. F Q:$G(PSJDONE)!$G(PSJSTOP) D
  1. .D SELUSER^PSJPDRUT(.PSJINP,.USER,.SELUSER,.USERX,.PSJSTOP)
  1. S PSJUSER=$G(SELUSER)
  1. S USER="" F S USER=$O(SELUSER(USER)) Q:USER="" D
  1. .S PSJUSER(USER)=SELUSER(USER)
  1. Q
  1. ;
  1. TRANS(PSJINP,PSJTRANS,PSJOVR) ; Get Transaction Types of PADE transactions
  1. N PSJDONE K PSJTRANS,PSJOVR,PSJTRX
  1. F Q:$G(PSJSTOP)!$G(PSJDONE) D SELTRANS(.PSJTRANS,.PSJTRX)
  1. Q:$G(PSJSTOP)
  1. ; Prompt for override only if a Vend (PSJTRANS(1)) or Return (PSJTRANS(7)) was selected
  1. I $D(PSJTRX("Dispense"))!$D(PSJTRX("Return"))!$D(PSJTRX("Waste")) S PSJOVR=$$OVRTRAN()
  1. Q
  1. ;
  1. OVRTRAN() ; Prompt if only override transactions - only prompt if DISPENSE/VEND type was selected
  1. N DIR
  1. S DIR(0)="YA",DIR("B")="N"
  1. S DIR("A")="Select Override Transaction only? "
  1. S DIR("?",1)=" Select 'Y' to display transactions where the user"
  1. S DIR("?",2)=" dispensed an item without an order. Otherwise ALL"
  1. S DIR("?")=" entries will be displayed."
  1. D ^DIR I $G(DUOUT)!$G(DTOUT) S PSJSTOP=1 Q ""
  1. Q Y
  1. ;
  1. SELTRANS(TRANS,TRANSX) ; Prompt for one transaction type (or ALL)
  1. N DIR
  1. W ! D EN^DDIOL(" Enter '^ALL' to select all Transaction Types.") W !
  1. ;
  1. D TRANLIST(.PSJINP,.DIR)
  1. D ^DIR I X="",$D(TRANS)<10 S Y="ALL"
  1. I $E(X)["^" S Y=$$XALL^PSJPDRIP(X)
  1. I $G(DTOUT)!$G(DUOUT) S PSJSTOP=1 Q
  1. I Y="",$D(TRANS)>1 S PSJDONE=1 Q
  1. I Y="ALL" S PSJDONE=1 D Q
  1. .N PADLIST,CNT,TXPIECE
  1. .S PADLIST=$P(DIR(0),"^",2)
  1. .F CNT=1:1:$L(PADLIST,";") S TXPIECE=$P(PADLIST,";",CNT) S TRANS($P(TXPIECE,":"))=$P(TXPIECE,":",2),TRANSX($P(TXPIECE,":",2))=$P(TXPIECE,":")
  1. .S TRANS="ALL"
  1. I Y>0 D
  1. .N PADLIST,CNT,TXPIECE
  1. .S PADLIST=$P(DIR(0),"^",2)
  1. .F CNT=1:1:$L(PADLIST,";") S TXPIECE=$P(PADLIST,";",CNT) I +TXPIECE=+Y S TRANS($P(TXPIECE,":"))=$P(TXPIECE,":",2),TRANSX($P(TXPIECE,":",2))=$P(TXPIECE,":")
  1. Q
  1. ;
  1. LIST(NLIST,MSG,MAX,AUDIT) ; Write list in LIST(ID1)=ID1
  1. N II,NAME,NUMBER,TAB,NAME,ID1,ID2,PSCNT,DUOUT,DTOUT,DIR,X,Y,LIST,LISTX
  1. K AUDIT S AUDIT=1 ; Return evidence this was called
  1. S $P(TAB," ",80)=""
  1. S PSCNT=0
  1. Q:$D(NLIST)<10
  1. I $L($G(MSG)) W !,MSG,!
  1. I $D(MSG)>1 D W !
  1. .S II=0 F S II=$O(MSG(II)) Q:'II W !,MSG(II)
  1. S ID2="" F S ID2=$O(NLIST(ID2)) Q:ID2="" S NAME=$G(NLIST(ID2)) S:NAME="" NAME="UNKNOWN" D
  1. .S LIST($P(NAME,"^")_"^"_ID2)=$P(NAME,"^",2),LISTX(ID2)=$P(NAME,"^")_"^"_ID2
  1. S II="" F S II=$O(LISTX(II)) Q:II=""!$G(DTOUT)!$G(DUOUT) D
  1. .S ID1=LISTX(II)
  1. .N PSJMARG
  1. .S PSJMARG=" "
  1. .S PSJMARG=$S($E(ID1)="*":$E(TAB,1,17),$E(II)="*":$E(TAB,1,17),1:$E(TAB,1,12-$L($P(ID1,"^",2))))
  1. .W !," "_$P(ID1,"^",2)_PSJMARG_$P(ID1,"^")_" "_$P(LIST(ID1),"^")
  1. .S PSCNT=$G(PSCNT)+1
  1. .I $G(MAX),(PSCNT>$G(MAX)) W !! S DIR(0)="E" D ^DIR S PSCNT=0 W !!
  1. Q
  1. ;
  1. PROCESS(PSJINP) ; Gather report data, store in ^TMP
  1. N PSJBDT,PSJSCR,TSCREEN
  1. S PSJBDT=$G(PSJINP("PSJBDT"))
  1. S PSJSCR="I $$TSCREEN^PSJPDRTP(Y,.PSJINP)"
  1. D LIST^DIC(58.6,,"@;2;1;23;10;.01I;4;15;12;3;16;14I;6.1;6.2;7.1;7.2;21;25;18;19;1.2;11;13","P",,PSJBDT,,"B",PSJSCR,,"^TMP($J,""TSCREEN"")")
  1. D PROCSUM^PSJPDRTP(.PSJINP) Q
  1. K ^TMP(PSJDLRJ,"TSCREEN")
  1. Q
  1. ;
  1. DIVSTR(PSJINP) ; Return Divisions in PSJINP("PSJDIV") in string
  1. N DIVSTR,DIV,II,DIVNAM
  1. S DIVSTR=""
  1. I PSJINP("PSJDIV")="ALL" Q "ALL"
  1. ;
  1. S DIV="" F II=0:1 S DIV=$O(PSJINP("PSJDIV",DIV)) Q:DIV="" D
  1. .S DIVNAM=$P($G(^DG(40.8,+DIV,0)),"^")
  1. .S DIVSTR=DIVSTR_$S(II:",",1:"")_DIVNAM
  1. Q DIVSTR
  1. ;
  1. TRANLIST(PSJINP,DIR) ; Set selectable transactions into DIR based on patient selection
  1. N PATFLG,PADLIST,CNT,TXPIECE,LAST,PSJPSYS,PSJBDT,PSJEDT
  1. S PATFLG=0
  1. S PSJPSYS=+$G(PSJINP("PSJPSYS")),PSJBDT=+$G(PSJINP("PSJBDT")),PSJEDT=+$G(PSJINP("PSJEDT"))
  1. ; Filter to include ONLY transactions that have received from this vendor during this date range
  1. S DIR(0)="SOA^"_$$TTYPDIR^PSJPDRUT(PSJPSYS,PSJBDT,PSJEDT)
  1. I '$P(DIR(0),"^",2) D Q
  1. .K DIR S DIR("A")="No recognized Transaction types have been received for this vendor system."
  1. .S PSJSTOP=-1
  1. S DIR("A")="Select Transaction Type: "_$S($D(TRANS)>1:"",1:"^ALL//")
  1. S DIR("A",1)="Select one of the following transaction types:"
  1. S PADLIST=$P(DIR(0),"^",2)
  1. F CNT=1:1:$L(PADLIST,";") S TXPIECE=$P(PADLIST,";",CNT) D
  1. .S DIR("A",CNT+1)=" "_$P(TXPIECE,":")_" "_$P(TXPIECE,":",2)
  1. S LAST=$O(DIR("A",999999),-1)
  1. S DIR("A",LAST+1)=" or ^ALL for all Transactions."
  1. Q