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

PSJPDRIP.m

Go to the documentation of this file.
  1. PSJPDRIP ;BIR/MV-MAIN DRIVER PADE INVENTORY REPORT ;18 JUN 96 / 2:58 PM
  1. ;;5.0;INPATIENT MEDICATIONS;**317**;16 DEC 97;Build 130
  1. ;
  1. ; Reference to ^%ZISC is supported by DBIA 10089.
  1. ; Reference to ^XLFDT is supported by DBIA 10103.
  1. ; Reference to ^DG(40.8 is supported by DBIA 728.
  1. ; Reference to ^PSDRUG is supported by DBIA 2192.
  1. ; Reference to ^VA(200 is supported by DBIA 10060.
  1. Q
  1. ;
  1. EN(PSJINP) ; Write PADE Inventory Report
  1. ; Required : ^TMP("PSJPDRIN",$J global array containing report data in delimited format.
  1. ; PSJINP array
  1. ; PSJINP("PADEV") = PADE device(s) (pointer to PADE DISPENSING DEVICE #58.63) selected by user
  1. ; PSJINP("PSDRG") = Drug(s) (pointer to DRUG #50) selected by user
  1. ; PSJINP("PSJCSUB") = CS Federal Schedule(s) selected by user
  1. ; PSJINP("PSJDEV",CABIEN) = Pointer to PADE DISPENSING DEVICE (#58.63) file
  1. ; PSJINP("PSJDELM") = (D)elimited or formatted (R)eport, selected by user
  1. ; PSJINP("PSJDIV") = Division (pointer to MEDICAL CENTER DIVISION #40.8) selected by user
  1. ; PSJINP("PSJPSYS" = PADE INVENTORY SYSTEM (#58.601) selected by user
  1. ; PSJINP("PSJSUM" = (S)ummary or (D)etail report, selected by user
  1. ;
  1. N PSJDELIM,PSJQUIT,PSJIOSL,PSPGTOT,LNCNT,PSJPTOT,DTOUT,DUOUT,DA,DIC,X,Y,DIR,DR
  1. S PSJIOSL=$S($G(IOSL):IOSL-5,1:20)
  1. S PSJDELIM=$G(PSJINP("PSJDELM"))
  1. U IO
  1. I PSJDELIM="D" D DELIM(.PSJINP)
  1. I PSJDELIM="R" D FORMAT(.PSJINP)
  1. Q
  1. ;
  1. DELIM(PSJINP) ; Output delimited report
  1. N PSJPGTOT,PSJPCNT
  1. S PSJPTOT=1,PSJPCNT=1
  1. D RHEAD^PSJPDRIP(.PSJINP,PSJPTOT,PSJPCNT)
  1. S LNCNT=0 F S LNCNT=$O(^TMP("PSJPDRIN",$J,LNCNT)) Q:'LNCNT!$G(PSJQUIT) D
  1. .W !,^TMP("PSJPDRIN",$J,LNCNT)
  1. D ^%ZISC
  1. D EXIT
  1. Q
  1. ;
  1. FORMAT(PSJINP) ; Output formatted report
  1. N CABNAME,PSJPGTOT,PSJPCNT
  1. S PSJPCNT=1,PSJPGTOT=$$PGTOT()
  1. D RHEAD^PSJPDRIP(.PSJINP,PSJPCNT,PSJPGTOT)
  1. S LNCNT=0 F S LNCNT=$O(^TMP("PSJPDRIN",$J,LNCNT)) Q:'LNCNT!$G(PSJQUIT) D
  1. .N LINE,PSCOL
  1. .S LINE=$G(^TMP("PSJPDRIN",$J,LNCNT))
  1. .D SETCOLS(.PSJINP,.PSCOL)
  1. .I $G(PSJINP("PSJSUM"))="S" I $L($P(LINE,"^"))>1 S CABNAME=$P(LINE,"^")
  1. .W !?PSCOL(1),$P(LINE,"^"),?PSCOL(2),$P(LINE,"^",2),?PSCOL(3),$P(LINE,"^",3),?PSCOL(4),$P(LINE,"^",4),?PSCOL(5),$P(LINE,"^",5),?PSCOL(6),$P(LINE,"^",6)
  1. .N CABCONT
  1. .Q:($Y<(PSJIOSL))
  1. .I ($G(PSJINP("PSJSUM"))="S") I $G(CABNAME)]"" I ($P(LINE,"^")]"")!($P(LINE,"^",2)]"") D
  1. ..N NXT S NXT=+$O(^TMP("PSJPDRIN",$J,LNCNT))
  1. ..S NXT=$P($G(^TMP("PSJPDRIN",$J,NXT)),"^") S:NXT="" CABCONT=CABNAME_"(cont) "
  1. .D CONT(.PSJPCNT,.PSJQUIT,LNCNT)
  1. .Q:$G(PSJQUIT)
  1. .D RHEAD(.PSJINP,PSJPCNT,PSJPGTOT,$G(CABCONT))
  1. I '$G(PSJQUIT) D CONT(.PSJPCNT,.PSJQUIT,$O(^TMP("PSJPDRIN",$J,9999999),-1)+1)
  1. D ^%ZISC
  1. D EXIT
  1. Q
  1. ;
  1. RHEAD(PSJINP,PSJPCNT,PSJPGTOT,CABCONT) ; Report Header
  1. N PSPGCNT,PSJDIV,CSCHED,PSJTMP,PADECAB,PADEDRG,PSJII,PSJCABS,PSJSUM
  1. S PSJPGTOT=$S($G(PSJPGTOT):+$G(PSJPGTOT),1:1)
  1. S PSJDIV=$G(PSJINP("PSJDIV"))
  1. S PSPGTOT=$G(PSJINP("PSPGTOT")),PSPGCNT=1
  1. S PSJSUM=$G(PSJINP("PSJSUM"))
  1. W @IOF
  1. W !,"Run Date: "_$P($TR($$FMTE^XLFDT($$NOW^XLFDT,2),"@"," "),":",1,2)
  1. W ?27,"PADE On Hand Amounts Report ",$S(($G(PSJSUM)="S"):"(Summary)",1:"(Detail)")
  1. W ?66,"Page ",PSJPCNT," of ",PSJPGTOT
  1. W !,"Run By: ",$P($G(^VA(200,+$G(DUZ),0)),"^")
  1. W ?35,"Division: ",$E($$DIVSTR^PSJPDRTR(.PSJINP),1,44)
  1. S CSCHED=$$CSCHED(.PSJINP)
  1. W !,"CS/Non-CS: ",$S($G(PSJINP("PSJCSUB"))="N":"N",1:$G(CSCHED))
  1. S PSJCABS=$$CABSTR(.PSJINP)
  1. W !,"PADE"_$S(PSJCABS[",":"s: ",1:": "),PSJCABS
  1. S PADEDRG=$$DRGSTR(.PSJINP)
  1. W !,"ITEM"_$S(PADEDRG[",":"(s): ",1:": "),PADEDRG
  1. D:($G(PSJINP("PSJSUM"))="S") SUMHEAD(.PSJINP,$G(CABCONT))
  1. D:($G(PSJINP("PSJSUM"))="D") DETHEAD(.PSJINP)
  1. Q
  1. ;
  1. SUMHEAD(PSJINP,CABCONT) ; Summary specific header
  1. N DASHES,BLANK,PSJCOL
  1. I $G(PSJINP("PSJDELM"))="D" D Q
  1. .W !,"PADE^ITEM^UNIT^QTY"
  1. D SETCOLS(.PSJINP,.PSJCOL)
  1. S $P(DASHES,"-",80)="-"
  1. S $P(BLANK," ",80)=""
  1. W !,DASHES
  1. W !?2,"ITEM",?PSJCOL(3)-1,"UNIT",?PSJCOL(4)+1,"QTY"
  1. W !,DASHES
  1. W !,$S($G(CABCONT)]"":CABCONT,1:BLANK)
  1. Q
  1. ;
  1. DETHEAD(PSJINP) ; Detail specific header
  1. N DASHES,PSJCOL
  1. I $G(PSJINP("PSJDELM"))="D" D Q
  1. .W !,"ITEM^UNIT^QTY^PADE^ITEM LOCATION"
  1. D SETCOLS(.PSJINP,.PSJCOL)
  1. S $P(DASHES,"-",80)="-"
  1. W !,DASHES
  1. W !,"ITEM",?PSJCOL(2),"UNIT",?PSJCOL(3)," QTY",?PSJCOL(4),"PADE",?PSJCOL(5),"ITEM LOCATION"
  1. W !,DASHES
  1. Q
  1. ;
  1. EXIT ; Clean up.
  1. K ^TMP("PSJPDRIN",$J)
  1. Q
  1. ;
  1. POCKDRG(PSJPSYS,PSJCAB,DRUG,DRWPCK) ; Get Drawer.Pocket location of DRUG in PSJCAB cabinet
  1. ;
  1. N CABIEN,DRGIEN,DRWIEN,DRWNAM,PCKIEN,PCKNAM,ND,LOCNAM,PSJII
  1. Q:'$G(PSJPSYS)!'$G(PSJCAB)!'$G(PSJCAB)
  1. S CABIEN=$$FIND1^DIC(58.6011,","_PSJPSYS_",","MXQ",+$G(PSJCAB),,,"ERR")
  1. S DRWIEN=0 F S DRWIEN=$O(^PS(58.601,PSJPSYS,"DEVICE",CABIEN,"DRAWER",DRWIEN)) Q:'DRWIEN S DRWNAM=$P(^(DRWIEN,0),"^") D
  1. .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
  1. ..N LOCNAM,SUBID
  1. ..S SUBID=$P(ND,"^",4) S:SUBID["~~" SUBID=$P(SUBID,"~~") S:SUBID="" SUBID="N/A"
  1. ..S PCKNAM=DRWNAM_"_"_SUBID_"_"_$P(ND,"^",3)
  1. ..F PSJII=1:1:$L(PCKNAM,"_") D
  1. ...N TMPLOC S TMPLOC=$P(PCKNAM,"_",PSJII)
  1. ...S TMPLOC=$S(TMPLOC="~~":"N/A",1:TMPLOC)
  1. ...S LOCNAM=$G(LOCNAM)_TMPLOC_"_"
  1. ..S:$E(LOCNAM,$L(LOCNAM))="_" LOCNAM=$E(LOCNAM,1,$L(LOCNAM)-1)
  1. ..S DRWPCK(DRUG,LOCNAM)=$P(ND,"^",2)
  1. Q
  1. ;
  1. CONT(PGCNT,PSJQUIT,TMPLN) ; Press return to continue
  1. N DIR
  1. I ($E($G(IOST))="C") W ! D Q:$G(PSJQUIT)
  1. .I '$O(^TMP("PSJPDRIN",$J,TMPLN)) S DIR("A")="End of Report. Press Return to continue" S PSJQUIT=1
  1. .S DIR(0)="E"
  1. .D ^DIR K DIR
  1. .I $G(DTOUT)!$G(DUOUT) S PSJQUIT=1
  1. .W @IOF
  1. S PGCNT=$G(PGCNT)+1
  1. Q
  1. ;
  1. PGTOT() ; Return calculated number of pages for this report
  1. N PGTOT,LN,PSJSL,INT,HDRPAD,HDR,HDRWRAP,SCHWRAP,PADEWRAP,DRGWRAP,PSJAVAIL,HDRTOP
  1. S PSJIOSL=$S($G(PSJIOSL):PSJIOSL,1:20)
  1. S LN=$O(^TMP("PSJPDRIN",$J,999999999),-1)
  1. S SCHWRAP=($L($$CSCHED(.PSJINP))+10)/80
  1. S:SCHWRAP#1 SCHWRAP=(SCHWRAP\1)+1
  1. S PADEWRAP=($L($$CABSTR(.PSJINP))+6)/80
  1. S:PADEWRAP#1 PADEWRAP=(PADEWRAP\1)+1
  1. S DRGWRAP=($L($$DRGSTR(.PSJINP))+7)/80
  1. S:DRGWRAP#1 DRGWRAP=(DRGWRAP\1)+1
  1. S HDRWRAP=SCHWRAP+PADEWRAP+DRGWRAP
  1. S HDRTOP=$S($G(PSJINP("PSJSUM"))="D":5,1:6)
  1. S HDRPAD=(HDRTOP+HDRWRAP)
  1. ; How many lines are availabe for actual report data, after header and footer are taken into account?
  1. ; If less than five lines per page for report data, set to 5 (longer page length needed)
  1. S PSJAVAIL=PSJIOSL-HDRPAD
  1. ; Determine how many pages will be needed to print the total lines in ^TMP("PSJPDRIN",
  1. ; using the available area (PSJAVAIL) on each page
  1. S PGTOT=LN\PSJAVAIL
  1. ;S PSJLASTP=LN#PSJAVAIL
  1. S:LN#PSJAVAIL PGTOT=PGTOT+1
  1. ;
  1. Q PGTOT
  1. ;
  1. CSCHED(PSJINP) ; Return string of CS Federal Schedules from array PSJINP("PSJCSUB",SCHEDULE)
  1. N CSCHED N PSJTMP
  1. S CSCHED=$G(PSJINP("PSJCSUB")) I '(CSCHED="N") S CSCHED="CS (" D
  1. .I $G(PSJINP("PSJCSUB"))["ALL" S CSCHED=PSJINP("PSJCSUB") Q
  1. .S PSJTMP="" F S PSJTMP=$O(PSJINP("PSJCSUB",PSJTMP)) Q:PSJTMP="" S CSCHED=CSCHED_PSJTMP_","
  1. .I $E(CSCHED,$L(CSCHED))="," S CSCHED=$E(CSCHED,1,$L(CSCHED)-1)_")"
  1. Q CSCHED
  1. ;
  1. CABSTR(PSJINP) ; Return string of PADE cabinets from array PSJINP("PADEV",CABINET)
  1. N CABSTR N PSJTMP,PSJII,PSJDONE
  1. S PSJTMP=0 F PSJII=0:1 S PSJTMP=$O(PSJINP("PADEV",PSJTMP)) Q:'PSJTMP!$G(PSJDONE) D
  1. .I $G(PSJINP("PADEV"))="ALL" S CABSTR="ALL",PSJDONE=1 Q
  1. .I $L($G(CABSTR))+$L($P($G(^PS(58.63,+PSJTMP,0)),"^"))>140 S CABSTR=CABSTR_" >> more..." S PSJDONE=1 Q
  1. .S CABSTR=$S(PSJII:$G(CABSTR)_",",1:"")_$P($G(^PS(58.63,+PSJTMP,0)),"^")
  1. Q CABSTR
  1. ;
  1. DRGSTR(PSJINP) ; Return string of PADE drugs selected by user from PSJINP("PSDRG",DRUG IEN)
  1. N PADEDRG,PSJTMP,PSJII,PSJDONE
  1. S PADEDRG="",PSJTMP="" F PSJII=0:1 S PSJTMP=$O(PSJINP("PSDRG",PSJTMP)) Q:'PSJTMP!$G(PSJDONE) D
  1. .I $G(PSJINP("PSDRG"))="ALL" S PADEDRG="ALL",PSJDONE=1 Q
  1. .S PADEDRG=$S(PSJII:(PADEDRG_","),1:"")_$P($G(^PSDRUG(+PSJTMP,0)),"^")
  1. .I $L(PADEDRG)>187 S PADEDRG=PADEDRG_" > more..." S PSJDONE=1 Q
  1. S:$E(PADEDRG,$L(PADEDRG)) PADEDRG=$E(PADEDRG,1,$L(PADEDRG)=1)
  1. Q PADEDRG
  1. ;
  1. SETCOLS(PSJINP,COL) ; Set column widths
  1. I $G(PSJINP("PSJSUM"))="S" D
  1. .S COL(1)=0,COL(2)=2,COL(3)=50,COL(4)=60,COL(5)=68,COL(6)=74
  1. I $G(PSJINP("PSJSUM"))="D" D
  1. .S COL(1)=0,COL(2)=38,COL(3)=48,COL(4)=53,COL(5)=64,COL(6)=75
  1. Q
  1. ;
  1. TRANSTR(PSJINP) ; Return string of transaction types selected
  1. N TRANS,TMP,II,PATFLG
  1. S PATFLG=$$PTTRFLG^PSJPDRU1(.PSJINP)
  1. S TRANS=""
  1. I $G(PSJINP("PSJTRANS"))="ALL"&(PATFLG=1) Q "ALL"
  1. I $G(PSJINP("PSJTRANS"))="ALL"&(PATFLG=2) Q "ALL PATIENT TRANSACTIONS"
  1. I $G(PSJINP("PSJTRANS"))="ALL"&'PATFLG Q "ALL NON-PATIENT TRANSACTIONS"
  1. S TMP="" F II=0:1 S TMP=$O(PSJINP("PSJTRANS",TMP)) Q:TMP="" S TRANS=$S(II:TRANS_","_PSJINP("PSJTRANS",TMP),1:PSJINP("PSJTRANS",TMP))
  1. Q TRANS
  1. ;
  1. CABST(PSJPSYS,PSJPADE) ; Return PADE Status : (I)=Inactive or null
  1. N STATUS,PADIEN
  1. Q:'$G(PSJPSYS) ""
  1. Q:$G(PSJPADE)="" ""
  1. S PADIEN=$$FIND1^DIC(58.63,,,PSJPADE)
  1. Q:'PADIEN ""
  1. S STATUS=$P($G(^PS(58.63,+PADIEN,0)),"^",4)
  1. S STATUS=$S(STATUS="I":"(I)",1:"")
  1. Q STATUS
  1. ;
  1. XALL(IN) ; Convert partial ^ALL to ALL
  1. N OUT
  1. S OUT=IN
  1. I ($E(IN)'="^")!(IN="^") Q OUT
  1. S OUT=$$ENLU^PSGMI(OUT)
  1. I $E(OUT,1,$L(OUT))=$E("^ALL",1,$L(OUT)) D
  1. .S OUT="ALL"
  1. .K DUOUT,DTOUT
  1. Q OUT
  1. ;
  1. CONT2(PGCNT,PSJQUIT,PSJEND) ; Press return to continue
  1. N DIR
  1. I ($E($G(IOST))="C") W ! D Q:$G(PSJQUIT)
  1. .I $G(PSJEND) S DIR("A")="End of Report. Press Return to continue" S PSJQUIT=1
  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 PSJQUIT=1
  1. .W @IOF
  1. S PGCNT=$G(PGCNT)+1
  1. Q
  1. ;
  1. CNVTYP(INTYP,PSJOUT) ; Convert Transaction Types to external format from raw HL7
  1. N TTCNT,PSJOUTE K PSJOUT
  1. S TTCNT=0 F S TTCNT=$O(INTYP(TTCNT)) Q:'TTCNT D
  1. .N TTNAME,TTCODE S TTNAME=INTYP(TTCNT)
  1. .S TTCODE=$$EXTT^PSJPDRUT(TTNAME)
  1. .I TTCODE]"" S PSJOUT(TTCODE)=TTNAME
  1. .Q
  1. .I $E(INTYP(TTCNT))="D" S PSJOUT("V")="VEND",PSJOUT("I")="ISSUE" Q
  1. .I $E(INTYP(TTCNT))="L" S PSJOUT("L")="LOAD" Q
  1. .I $E(INTYP(TTCNT))="F" S PSJOUT("F")="FILL" Q
  1. .I $E(INTYP(TTCNT))="U" S PSJOUT("U")="UNLOAD" Q
  1. .I $E(INTYP(TTCNT))="B" S PSJOUT("B")="EMPTY BIN" Q
  1. .I $E(INTYP(TTCNT))="C" S PSJOUT("C")="COUNT" Q
  1. .I $E(INTYP(TTCNT))="R" S PSJOUT("R")="RETURN" Q
  1. .I $E(INTYP(TTCNT))="W" S PSJOUT("W")="WASTE" Q
  1. .I $E(INTYP(TTCNT))="E" S PSJOUT("E")="EXPIRED" Q
  1. .I INTYP(TTCNT)="Destock" S PSJOUT("D")="DESTOCK" Q
  1. Q
  1. ;
  1. ALLSCHED(PSJCSUB,SCHLST) ; Return all CS Federal Schedules in PSJCSUB(SCHEDULE)
  1. N SCHED,SCNT
  1. F SCNT=1:1:$L(SCHLST,";") S SCHED=$P(SCHLST,";",SCNT),PSJCSUB($P(SCHED,":"))=$P(SCHED,":",2)
  1. Q
  1. ;
  1. DIV(PSJDIV,PSJSTOP) ; Get Division
  1. N DIC,X,Y,PSJDONE,PSDIVLST,PSJDIC
  1. S DIC("S")="I $D(^PS(58.63,""D"",+Y))"
  1. S PSJSTOP=0
  1. D LIST^DIC(40.8,,,"P",,,,,DIC("S"),,"PSDIVLST")
  1. S PSJDIC=0 F S PSJDIC=$O(PSDIVLST("DILIST",PSJDIC)) Q:'PSJDIC D
  1. .S PSDIVLST=+$G(PSDIVLST("DILIST",PSJDIC,0))
  1. .S PSDIVLST("PSJDIV",PSDIVLST)=""
  1. S PSJDIV="" K PSJDONE,PSJDIV
  1. S DIC("S")="I $D(^PS(58.63,""D"",+Y))"
  1. D DIV^PSJPDRUT(.PSJDIV,.PSJSTOP)
  1. Q