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

ORWD1.m

Go to the documentation of this file.
  1. ORWD1 ; SLC/KCM/REV - GUI Prints; 28-JAN-1999 12:51 ;7/31/06 11:34
  1. ;;3.0;ORDER ENTRY/RESULTS REPORTING;**10,85,140,215,260,492**;Dec 17, 1997;Build 3
  1. ;Per VHA Directive 2004-038, this routine should not be modified.
  1. ;
  1. PRINTS(PRTLST,HLOC,ORWDEV) ; Do the auto-prints after signing orders
  1. ; PRTLST(n)=ORIFN;ACT^Chart^Label^Requisition^Service^Work
  1. Q:$G(A7RNDBI) ; per NDBI, to suppress prints during integration
  1. N ADEVICE,TMPLST S HLOC=+HLOC_";SC("
  1. ; if there is a print device for chart copies, print chart copies
  1. D MKLST(2) I $D(TMPLST)>1 D ; Print Chart Copies
  1. . ;*492 only print from CPRS when device is passed in otherwise use default
  1. . S ADEVICE=$S($G(ORWDEV)'="":+$P($G(ORWDEV),U,1),1:$$GET^XPAR(HLOC,"ORPF CHART COPY PRINT DEVICE",1,"I"))
  1. . I ADEVICE D GUI^ORPR02(.TMPLST,ADEVICE,"C",HLOC)
  1. D MKLST(3) I $D(TMPLST)>1 D ; Print Labels
  1. . ;*492 only print from CPRS when device is passed in otherwise use default
  1. . S ADEVICE=$S($G(ORWDEV)'="":+$P($G(ORWDEV),U,2),1:$$GET^XPAR(HLOC,"ORPF LABEL PRINT DEVICE",1,"I"))
  1. . I ADEVICE D GUI^ORPR02(.TMPLST,ADEVICE,"L",HLOC)
  1. D MKLST(4) I $D(TMPLST)>1 D ; Print Requisitions
  1. . ;*492 only print from CPRS when device is passed in otherwise use default
  1. . S ADEVICE=$S($G(ORWDEV)'="":+$P($G(ORWDEV),U,3),1:$$GET^XPAR(HLOC,"ORPF REQUISITION PRINT DEVICE",1,"I"))
  1. . I ADEVICE D GUI^ORPR02(.TMPLST,ADEVICE,"R",HLOC)
  1. D MKLST(5) I $D(TMPLST)>1 D ; Print Service Copies
  1. . D GUI^ORPR02(.TMPLST,"","S",HLOC)
  1. D MKLST(6) I $D(TMPLST)>1 D ; Print Work Copies
  1. . ;*492 only print from CPRS when device is passed in otherwise use default
  1. . S ADEVICE=$S($G(ORWDEV)'="":+$P($G(ORWDEV),U,4),1:$$GET^XPAR(HLOC,"ORPF WORK COPY PRINT DEVICE",1,"I"))
  1. . I ADEVICE D GUI^ORPR02(.TMPLST,ADEVICE,"W",HLOC)
  1. Q
  1. MKLST(APIECE) ; Make a list to pass to GUI^ORPR02, called only from PRINTS
  1. ; expect PRTLST to be defined, creates new TMPLST
  1. N I,J,ORIFN,ACT,NOA,PKG,DLG K TMPLST
  1. S I="",J=0 F S I=$O(PRTLST(I)) Q:I'>0 D
  1. . I ($L(PRTLST(I),U)>1),'$P(PRTLST(I),"^",APIECE) Q
  1. . S ORIFN=+PRTLST(I),ACT=+$P(PRTLST(I),";",2)
  1. . S NOA=+$P($G(^OR(100,ORIFN,8,ACT,0)),U,12)
  1. . I APIECE=2,'$P($G(^ORD(100.02,NOA,1)),U,2) Q ; no chart copies
  1. . I APIECE=6,'$P($G(^ORD(100.02,NOA,1)),U,5) Q ; no work copies
  1. . S PKG=+$P($G(^OR(100,+ORIFN,0)),U,14),DLG=+$P($G(^OR(100,+ORIFN,0)),U,5)
  1. . I APIECE=4,PKG=$O(^DIC(9.4,"B","DIETETICS",0)),DLG'=$O(^ORD(101.41,"B","FHW SPECIAL MEAL",0)) Q ;no requisitions
  1. . S J=J+1,TMPLST(J)=$P(PRTLST(I),U)
  1. Q
  1. PARAM(Y,LOC) ;Returns in 'Y' the print parameters
  1. ;Y=Prompt for CC^Prompt for L ^Prompt for R ^Prompt for W ^CC device ^L Device ^R Device ^WC device
  1. ;Device Params returned in internal;external format, the rest are internal
  1. ;CC=Chart Copy
  1. ;L=Label
  1. ;R=Requisitions
  1. ;WC=Work Copy
  1. ;'Prompt for' values (internal):
  1. ;0 for no prompts- chart copy is automatically generated.
  1. ;1 to prompt for chart copy and ask which printer should be used.
  1. ;2 to prompt for chart copy and automatically print to the
  1. ; printer defined in the CHART COPY PRINT DEVICE field.
  1. ;* don't print.
  1. ;LOC=Ptr to location ^SC(LOC,
  1. Q:'$G(LOC)
  1. S Y=$$BLDIT(LOC)
  1. Q
  1. BLDIT(LOC) ;Get Print parameters
  1. Q:'$G(LOC) ""
  1. N PARAM,I
  1. S PARAM=""
  1. F I="ORPF PROMPT FOR CHART COPY","ORPF PROMPT FOR LABELS","ORPF PROMPT FOR REQUISITIONS","ORPF PROMPT FOR WORK COPY" D
  1. . S PARAM=PARAM_$$XPAR(I,LOC,"Q")_"^"
  1. S PARAM=PARAM_$$XPAR("ORPF CHART COPY PRINT DEVICE",LOC)_"^"
  1. S PARAM=PARAM_$$XPAR("ORPF LABEL PRINT DEVICE",LOC)_"^"
  1. S PARAM=PARAM_$$XPAR("ORPF REQUISITION PRINT DEVICE",LOC)_"^"
  1. S PARAM=PARAM_$$XPAR("ORPF WORK COPY PRINT DEVICE",LOC)_"^"
  1. Q PARAM
  1. COMLOC(LOC,ORDERS) ; Return common location for orders in list, if any
  1. N I
  1. S LOC=0,I=0
  1. ; get the location for the first order that was signed or released
  1. F S I=$O(ORDERS(I)) Q:'I D Q:LOC
  1. . I $P(ORDERS(I),U,2)'["R",($P(ORDERS(I),U,2)'["S") Q
  1. . S LOC=+$P($G(^OR(100,+ORDERS(I),0)),U,10)
  1. ; compare the location to the following orders
  1. I LOC F S I=$O(ORDERS(I)) Q:'I D Q:'LOC
  1. . I $P(ORDERS(I),U,2)'["R",($P(ORDERS(I),U,2)'["S") Q
  1. . I (+$P($G(^OR(100,+ORDERS(I),0)),U,10)'=LOC) S LOC=0
  1. Q
  1. SIG4ONE(REQ,ANORDER) ; Return 1 if order requires a signature
  1. S REQ=0
  1. I +$P($G(^OR(100,+ANORDER,0)),U,16) S REQ=1
  1. Q
  1. SIG4ANY(REQ,ORDERS) ; Return 1 if any order requires a signature
  1. N I
  1. S I=0,REQ=0
  1. F S I=$O(ORDERS(I)) Q:'I D Q:REQ
  1. . I +$P($G(^OR(100,+ORDERS(I),0)),U,16) S REQ=1
  1. Q
  1. XPAR(NAME,LOC,FMT) ;Get parameter values
  1. Q:'$L(NAME) ""
  1. S:'$D(FMT) FMT="B"
  1. Q $TR($$GET^XPAR("ALL^"_+LOC_";SC(",NAME,1,FMT),"^",";")
  1. ;
  1. PRINTGUI(ORESULT,HLOC,ORWDEV,PRTLST) ; File|Print orders from GUI
  1. ;ORRACT is set here to identify this as a manual reprint
  1. N ADEVICE,ORRACT,ORPLST,I,PKG,DLG
  1. N BBPKG S BBPKG=+$O(^DIC(9.4,"B","VBECS",0))
  1. S PRTLST="",I=0
  1. K ORPLST M ORPLST=PRTLST
  1. S ORRACT=1,ADEVICE=$P(ORWDEV,U,1),ORESULT=1
  1. I +ADEVICE D GUI^ORPR02(.ORPLST,ADEVICE,"C",HLOC)
  1. S ADEVICE=$P(ORWDEV,U,2)
  1. K ORPLST M ORPLST=PRTLST
  1. D INSRTBB^ORWD2(.ORPLST) ; insert BB child Lab orders into ORPLST for printing labels
  1. I +ADEVICE D GUI^ORPR02(.ORPLST,ADEVICE,"L",HLOC)
  1. ;
  1. S ADEVICE=$P(ORWDEV,U,3)
  1. K ORPLST M ORPLST=PRTLST
  1. ;no FH order requisitions except special meals
  1. F S I=$O(ORPLST(I)) Q:'I D
  1. . S PKG=+$P($G(^OR(100,+ORPLST(I),0)),U,14),DLG=+$P($G(^OR(100,+ORPLST(I),0)),U,5)
  1. . I PKG=$O(^DIC(9.4,"B","DIETETICS",0)),DLG'=$O(^ORD(101.41,"B","FHW SPECIAL MEAL",0)) K ORPLST(I)
  1. D INSRTBB^ORWD2(.ORPLST) ; insert BB child Lab orders into ORPLST for printing requisitions
  1. I +ADEVICE,$D(ORPLST) D GUI^ORPR02(.ORPLST,ADEVICE,"R",HLOC)
  1. ;
  1. S ADEVICE=$P(ORWDEV,U,4)
  1. K ORPLST M ORPLST=PRTLST
  1. I +ADEVICE D GUI^ORPR02(.ORPLST,ADEVICE,"W",HLOC)
  1. ; D GUI^ORPR02(.ORPLST,"","S",HLOC) no svc copies from File|Print
  1. Q
  1. RVPRINT(OK,HLOC,ORWDEV,PRTLST) ; print orders from review/sign actions
  1. D PRINTS(.PRTLST,HLOC,ORWDEV) S OK=1
  1. Q
  1. SVONLY(OK,HLOC,PRTLST) ; print service copies only
  1. Q:$G(A7RNDBI) ; per NDBI, to suppress prints during integration
  1. N TMPLST,I,J
  1. S HLOC=+HLOC_";SC(",OK=1
  1. S I="",J=0 F S I=$O(PRTLST(I)) Q:I'>0 D
  1. . I ($L(PRTLST(I),U)>1),'$P(PRTLST(I),U,5) Q
  1. . S J=J+1,TMPLST(J)=$P(PRTLST(I),U)
  1. I $D(TMPLST)>1 D GUI^ORPR02(.TMPLST,"","S",HLOC)
  1. Q