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