ORWCSP ; ALB/MJK - Background Consult Report Print Driver ;1/24/95 15:49
;;3.0;ORDER ENTRY/RESULTS REPORTING;**10**;Dec 17, 1997
PRINT(ORY,ORIO,DFN,ORID) ; -- print report entry point
; RPC: ORWCS PRINT REPORT
; See RPC definition for details on input and output parameters
;
IF '$$CHK() G PRINTQ
; -- task job
N TASKDATA
S TASKDATA("DESC")="Consult Report Print"
S TASKDATA("RTN")="DEQUE^ORWCSP"
D TASK(.ORY,.ORIO,.DFN,.ORID,.TASKDATA)
PRINTQ Q
;
TASK(ORY,ORIO,DFN,ORID,TASKDATA) ;
;
N ZTDTH,ZTRTN,ZTSK,ZTDESC,ZTSAVE
S ZTIO=ORIO,ZTDTH=$H
S ZTDESC=TASKDATA("DESC")
S ZTRTN=TASKDATA("RTN")
S ZTSAVE("DFN")="",ZTSAVE("ORID")="",ZTSAVE("DUZ(")=""
D ^%ZTLOAD
I $D(ZTSK) D
. S ORY="0^Report queued. (Task #"_ZTSK_")"
E D
. S ORY="99^Task Rejected."
TASKQ Q
;
CHK() ; -- do checks for required data
; -- this check assumes all parameters in PRINT call are available
;
N OROK,FALSE,TRUE,ORRPT
S FALSE=0,TRUE=1
;
IF $G(ORIO)']"" S OROK=FALSE,ORY="1^No device selected." G CHKQ
;
IF '$G(ORID) S OROK=FALSE,ORY="2^No report specified." G CHKQ
;
IF '$D(^DPT(+$G(DFN),0)) S OROK=FALSE,ORY="6^Patient specified is not valid." G CHKQ
;
S OROK=TRUE
CHKQ Q OROK
;
DEQUE ; -- logic to print queued consult report
N ROOT,HDRDATA
;
; -- retrieve report text
D RPT^ORWCS(.ROOT,.DFN,.ORID)
;
; -- print report text
S HDRDATA("TITLE")="Consult Report"
S HDRDATA("DFN")=DFN
D OUTPUT(.ROOT,.HDRDATA)
DEQUEQ Q
;
OUTPUT(ROOT,HDRDATA) ; -- generic print report
N I
D INIT(.HDRDATA)
D HDR(.HDRDATA)
S I=0 F S I=$O(@ROOT@(I)) Q:'I D
. S HDRDATA("LCNT")=HDRDATA("LCNT")+1
. IF IOSL<(HDRDATA("LCNT")+5) D HDR(.HDRDATA)
. W !,@ROOT@(I,0)
Q
;
INIT(HDRDATA) ; -- init generic header data
N DFN0,DFN,X,VA
S DFN=$G(HDRDATA("DFN"))
S HDRDATA("PAGE")=0
S HDRDATA("LCNT")=0
; -- set up patient variables
S DFN0=$G(^DPT(DFN,0)),HDRDATA("NAME")=$P(DFN0,U)
D PID^VADPT6 S HDRDATA("PID")=VA("PID")
S X=$P(DFN0,U,3),HDRDATA("DOB")=$$FMTE^XLFDT(X,"D")
Q
;
HDR(ORY) ; -- print generic header
N LINE
S ORY("PAGE")=ORY("PAGE")+1,ORY("LCNT")=5
S $P(LINE,"-",80)=""
;
W @IOF
W !,ORY("TITLE"),?71,"Page: ",ORY("PAGE")
W !,"Name: ",ORY("NAME"),?37,"ID: ",ORY("PID"),?56,"DOB: ",ORY("DOB")
W !,LINE,!
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORWCSP 2327 printed Nov 22, 2024@17:45:03 Page 2
ORWCSP ; ALB/MJK - Background Consult Report Print Driver ;1/24/95 15:49
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**10**;Dec 17, 1997
PRINT(ORY,ORIO,DFN,ORID) ; -- print report entry point
+1 ; RPC: ORWCS PRINT REPORT
+2 ; See RPC definition for details on input and output parameters
+3 ;
+4 IF '$$CHK()
GOTO PRINTQ
+5 ; -- task job
+6 NEW TASKDATA
+7 SET TASKDATA("DESC")="Consult Report Print"
+8 SET TASKDATA("RTN")="DEQUE^ORWCSP"
+9 DO TASK(.ORY,.ORIO,.DFN,.ORID,.TASKDATA)
PRINTQ QUIT
+1 ;
TASK(ORY,ORIO,DFN,ORID,TASKDATA) ;
+1 ;
+2 NEW ZTDTH,ZTRTN,ZTSK,ZTDESC,ZTSAVE
+3 SET ZTIO=ORIO
SET ZTDTH=$HOROLOG
+4 SET ZTDESC=TASKDATA("DESC")
+5 SET ZTRTN=TASKDATA("RTN")
+6 SET ZTSAVE("DFN")=""
SET ZTSAVE("ORID")=""
SET ZTSAVE("DUZ(")=""
+7 DO ^%ZTLOAD
+8 IF $DATA(ZTSK)
Begin DoDot:1
+9 SET ORY="0^Report queued. (Task #"_ZTSK_")"
End DoDot:1
+10 IF '$TEST
Begin DoDot:1
+11 SET ORY="99^Task Rejected."
End DoDot:1
TASKQ QUIT
+1 ;
CHK() ; -- do checks for required data
+1 ; -- this check assumes all parameters in PRINT call are available
+2 ;
+3 NEW OROK,FALSE,TRUE,ORRPT
+4 SET FALSE=0
SET TRUE=1
+5 ;
+6 IF $GET(ORIO)']""
SET OROK=FALSE
SET ORY="1^No device selected."
GOTO CHKQ
+7 ;
+8 IF '$GET(ORID)
SET OROK=FALSE
SET ORY="2^No report specified."
GOTO CHKQ
+9 ;
+10 IF '$DATA(^DPT(+$GET(DFN),0))
SET OROK=FALSE
SET ORY="6^Patient specified is not valid."
GOTO CHKQ
+11 ;
+12 SET OROK=TRUE
CHKQ QUIT OROK
+1 ;
DEQUE ; -- logic to print queued consult report
+1 NEW ROOT,HDRDATA
+2 ;
+3 ; -- retrieve report text
+4 DO RPT^ORWCS(.ROOT,.DFN,.ORID)
+5 ;
+6 ; -- print report text
+7 SET HDRDATA("TITLE")="Consult Report"
+8 SET HDRDATA("DFN")=DFN
+9 DO OUTPUT(.ROOT,.HDRDATA)
DEQUEQ QUIT
+1 ;
OUTPUT(ROOT,HDRDATA) ; -- generic print report
+1 NEW I
+2 DO INIT(.HDRDATA)
+3 DO HDR(.HDRDATA)
+4 SET I=0
FOR
SET I=$ORDER(@ROOT@(I))
if 'I
QUIT
Begin DoDot:1
+5 SET HDRDATA("LCNT")=HDRDATA("LCNT")+1
+6 IF IOSL<(HDRDATA("LCNT")+5)
DO HDR(.HDRDATA)
+7 WRITE !,@ROOT@(I,0)
End DoDot:1
+8 QUIT
+9 ;
INIT(HDRDATA) ; -- init generic header data
+1 NEW DFN0,DFN,X,VA
+2 SET DFN=$GET(HDRDATA("DFN"))
+3 SET HDRDATA("PAGE")=0
+4 SET HDRDATA("LCNT")=0
+5 ; -- set up patient variables
+6 SET DFN0=$GET(^DPT(DFN,0))
SET HDRDATA("NAME")=$PIECE(DFN0,U)
+7 DO PID^VADPT6
SET HDRDATA("PID")=VA("PID")
+8 SET X=$PIECE(DFN0,U,3)
SET HDRDATA("DOB")=$$FMTE^XLFDT(X,"D")
+9 QUIT
+10 ;
HDR(ORY) ; -- print generic header
+1 NEW LINE
+2 SET ORY("PAGE")=ORY("PAGE")+1
SET ORY("LCNT")=5
+3 SET $PIECE(LINE,"-",80)=""
+4 ;
+5 WRITE @IOF
+6 WRITE !,ORY("TITLE"),?71,"Page: ",ORY("PAGE")
+7 WRITE !,"Name: ",ORY("NAME"),?37,"ID: ",ORY("PID"),?56,"DOB: ",ORY("DOB")
+8 WRITE !,LINE,!
+9 QUIT
+10 ;
