Routine: ORWCSP

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)

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")

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,!

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      ;

ORWCSP.m