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

BTPWTIUP.m

Go to the documentation of this file. 
  1. BTPWTIUP ;VNGT/HS/ALA-Print APIs ; 15 Jun 2010  4:33 PM
  1.  ;;1.0;CARE MANAGEMENT EVENT TRACKING;;Feb 07, 2011
  1.  ;
  1.  ;
  1. REM(NDATA,FAKE) ; EP -- BTPW GET REMOTE DEVICES
  1.  NEW UID,II,RESULT,MSG,DVN
  1.  S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1.  S NDATA=$NA(^TMP("BTPWTIUP",UID))
  1.  K @NDATA
  1.  ;
  1.  S II=0
  1.  NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BTPWTIUP D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
  1.  ;
  1.  ;Header
  1.  S @NDATA@(II)="T00030HIDE_TIUIO^T00050DEVICE_NAME^T00050LOCATION^T00005MARGIN"_$C(30)
  1.  ;
  1.  D DEVICE^CIAVUTIO(.DATA,"",-1)
  1.  S DVN=0
  1.  F  S DVN=$O(DATA(DVN)) Q:DVN=""  D
  1.  . S II=II+1,@NDATA@(II)=$P(DATA(DVN),U,1,4)_$C(30)
  1.  ;
  1. DONE ;
  1.  S II=II+1,@NDATA@(II)=$C(31)
  1.  Q
  1.  ;
  1. ERR ;
  1.  D ^%ZTER
  1.  NEW Y,ERRDTM
  1.  S Y=$$NOW^XLFDT() X ^DD("DD") S ERRDTM=Y
  1.  S BMXSEC="Recording that an error occurred at "_ERRDTM
  1.  S II=II+1,@NDATA@(II)=$C(31)
  1.  Q
  1.  ;
  1. PRW(DATA,TIUDA,TIUIO) ; EP -- BTPW PRINT TO RPMS DEVICE
  1.  ; Input Parameters
  1.  ;    TIUDA=document IEN
  1.  ;    TIUIO=device name
  1.  ;
  1.  NEW UID,II,RESULT,MSG,HDR
  1.  S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1.  S DATA=$NA(^TMP("BTPWPRWN",UID))
  1.  K @DATA
  1.  ;
  1.  S II=0
  1.  NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BTPWTIUP D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
  1.  ;
  1.  S HDR="I00010RESULT^T01024MSG"
  1.  S @DATA@(II)=HDR_$C(30)
  1.  D RPC^TIUPD(.RESULT,TIUDA,TIUIO,2,"") ; Print to a RPMS printer
  1.  I $P(RESULT,U,1)=1 S RESULT=-1,MSG=$P(RESULT,U,2)
  1.  I $P(RESULT,U,1)=0 S RESULT=1,MSG=$P(RESULT,U,2)
  1.  S II=II+1,@DATA@(II)=RESULT_U_MSG_$C(30)
  1.  S II=II+1,@DATA@(II)=$C(31)
  1.  Q
  1.  ;
  1. RPC(DATA,TIUFLAG,TIUIO,TIUWIN,TLIST) ; EP -- BTPW PRINT CMET TIU
  1.  ; Input Parameters
  1.  ;    TLIST=document IENs separate by $C(28)
  1.  ;    TIUIO=device name
  1.  ;    TIUFLAG 1=Chart Copy 2=Work Copy 3=Patient copy
  1.  ;    TIUWIN 1=Windows printer 0=RPMS printer
  1.  ;    TIUIO = If RPMS printer, DEVICE_NAME from BTPW GET REMOTE DEVICES
  1.  ;
  1.  NEW UID,II,TIUDA,TDATA,LIST
  1.  S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J),II=0
  1.  S DATA=$NA(^TMP("BTPWPRPV",UID)),TDATA=$NA(^TMP("BTPWPRX",UID))
  1.  K @DATA,@TDATA
  1.  ;
  1.  I $D(TLIST)>1 D
  1.  . S LIST="",BN=""
  1.  . F  S BN=$O(TLIST(BN)) Q:BN=""  S LIST=LIST_TLIST(BN)
  1.  . K TLIST S TLIST=LIST
  1.  ;
  1.  I TIUWIN D HDR
  1.  ;
  1.  F BTP=1:1 S TIUDA=$P(TLIST,$C(28),BTP) Q:TIUDA=""  D
  1.  . I 'TIUWIN D
  1.  .. S ZTIO=TIUIO,ZTDTH=$$FMADD^XLFDT($$NOW^XLFDT(),,,3)
  1.  .. S ZTDESC="Patient Copy PRINT for "_$$GET1^DIQ(8925,TIUDA_",",.01,"E")
  1.  .. S ZTRTN="PRT^BTPWTIUP",ZTSAVE("TLIST")="",ZTSAVE("TIUFLAG")=""
  1.  .. S ZTSAVE("DUZ(")=""
  1.  .. D ^%ZTLOAD
  1.  .. S @DATA@(II)="I00010RESULT"_$C(30)
  1.  .. S II=II+1,@DATA@(II)=1_$C(30)
  1.  .. K ZTSAVE,ZTIO,ZTDTH,ZTDESC,ZTRTN
  1.  . I TIUWIN D
  1.  .. NEW %,%H,%I,BJ,BN,BTI,BTP,DFN,FBN,HRCN,HSTEXT,I,LBN,NBN,QFL,VAERR
  1.  .. NEW TIUD0,TIUD13,TIUD15,TIUDATE,TIUIDDAD,TIUPFHDR,TIUPFNBR,TBN
  1.  .. NEW TIUPGRP,TIUPMTHD,TIUSIG,TIUTNM,TIUTYPE,BW,DRAFT,EBN,NLR,NPG
  1.  .. K ^TMP("TIUPR",$J)
  1.  .. S BTI=0
  1.  .. D PRM
  1.  .. I $$TMPFL^BQIUL1("W",UID,DFN) Q
  1.  .. U IO X TIUPMTHD
  1.  .. U IO W $C(23)
  1.  .. ;
  1.  .. I $$TMPFL^BQIUL1("C") Q
  1.  .. I $$TMPFL^BQIUL1("R",UID,DFN) Q
  1.  .. ;
  1.  .. F  U IO R HSTEXT:.1 Q:HSTEXT[$C(23)  D
  1.  ... S HSTEXT=$$STRIP^XLFSTR(HSTEXT,"^"),HSTEXT=$$CTRL^BQIUL1(HSTEXT)
  1.  ... I HSTEXT="" S HSTEXT=" "
  1.  ... S BTI=BTI+1,@TDATA@(BTI)=HSTEXT_$C(13)_$C(10)
  1.  .. ;
  1.  .. S NBN=0,LBN=$O(@TDATA@(""),-1)+1,TBN=LBN
  1.  .. S NPG=TBN\66,NLR=TBN#66 S:NLR>2 NPG=NPG+1
  1.  .. F BW=0:1:(NPG-1) D
  1.  ... S BN=$S(BW=0:0,1:(BW*66)+1)
  1.  ... S EBN=$S(BW=0:66,1:(BW*66)+66)
  1.  ... S QFL=0
  1.  ... F  S BN=$O(@TDATA@(BN)) Q:'BN!(QFL)  D
  1.  .... I @TDATA@(BN)["SUBJECT:",BW=0 S NBN=BN,QFL=1 Q
  1.  .... I @TDATA@(BN)["** CONTINUED FROM PREVIOUS",BW'=0 S NBN=BN,QFL=1
  1.  ... S BN=EBN,QFL=0
  1.  ... F  S BN=$O(@TDATA@(BN),-1) Q:'BN!(QFL)  D
  1.  .... I @TDATA@(BN)["** THIS NOTE CONTINUED ON NEXT PAGE",BW<NPG S FBN=BN,QFL=1 Q
  1.  .... I @TDATA@(BN)["----------",BW=(NPG-1) S FBN=(BN-6),QFL=1
  1.  ... S FBN=(FBN-1),DRAFT=0
  1.  ... F BJ=NBN+1:1:FBN D
  1.  .... I @TDATA@(BJ)["**DRAFT COPY" S DRAFT=1 Q
  1.  .... I DRAFT,@TDATA@(BJ)["Author: " Q
  1.  .... S II=II+1,@DATA@(II)=@TDATA@(BJ)
  1.  ... S II=II+1,@DATA@(II)=$C(12)
  1.  .. I $$TMPFL^BQIUL1("C") Q
  1.  .. I $$TMPFL^BQIUL1("D",UID,DFN) Q
  1.  . S II=II+1,@DATA@(II)=$C(30)
  1.  ;
  1.  S II=II+1,@DATA@(II)=$C(31)
  1.  ;
  1.  Q
  1.  ;
  1. PRM ; Get Print Method for the document
  1.  S TIUD0=$G(^TIU(8925,+TIUDA,0)),TIUD13=$G(^TIU(8925,+TIUDA,13))
  1.  S TIUD15=$G(^TIU(8925,+TIUDA,15)),TIUTYPE=+TIUD0,TIUFLAG=+$G(TIUFLAG)
  1.  S TIUDATE=$S(+TIUD15>0:+TIUD15,+TIUD13>0:+TIUD13,1:+$G(DT))
  1.  I '+TIUTYPE Q
  1.  S DFN=+$P(TIUD0,U,2)
  1.  S TIUTNM=$$PNAME^TIULC1(+TIUTYPE)
  1.  S TIUPMTHD=$$PRNTMTHD^TIULG(+TIUTYPE,TIUDA)
  1.  S TIUPGRP=$$PRNTGRP^TIULG(+TIUTYPE,TIUDA)
  1.  S TIUPFHDR=$$PRNTHDR^TIULG(+TIUTYPE,TIUDA)
  1.  S TIUPFNBR=$$PRNTNBR^TIULG(+TIUTYPE,TIUDA)
  1.  I +$$ISADDNDM^TIULC1(TIUDA) S TIUDA=+$P($G(^TIU(8925,+TIUDA,0)),U,6)
  1.  S TIUIDDAD=$$HASIDDAD^TIUGBR(TIUDA)
  1.  I TIUIDDAD S TIUDA=TIUIDDAD
  1.  I $G(TIUPMTHD)]"",+$G(TIUPGRP),($G(TIUPFHDR)]""),($G(TIUPFNBR)]"") D
  1.  . S ^TMP("TIUPR",$J,$G(TIUPGRP)_"$"_$G(TIUPFHDR)_";"_DFN,1,TIUDA)=$G(TIUPFNBR)
  1.  E  S ^TMP("TIUPR",$J,DFN,1,TIUDA)=""
  1.  Q
  1.  ;
  1. HDR ;
  1.  S @DATA@(II)="T02048REPORT_TEXT"_$C(30)
  1.  Q
  1.  ;
  1. PRT ;EP - Print to a RPMS printer
  1.  S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1.  S TDATA=$NA(^TMP("BTPWPRX",UID)) K @TDATA
  1.  F BTP=1:1 S TIUDA=$P(TLIST,$C(28),BTP) Q:TIUDA=""  D
  1.  . NEW %,%H,%I,BJ,BN,BTI,BTP,DFN,FBN,HRCN,HSTEXT,I,LBN,NBN,QFL,VAERR
  1.  . NEW TIUD0,TIUD13,TIUD15,TIUDATE,TIUIDDAD,TIUPFHDR,TIUPFNBR
  1.  . NEW TIUPGRP,TIUPMTHD,TIUSIG,TIUTNM,TIUTYPE
  1.  . K ^TMP("TIUPR",$J)
  1.  . S BTI=0
  1.  . D PRM
  1.  . NEW IO
  1.  . D
  1.  .. I $$TMPFL^BQIUL1("W",UID,DFN) Q
  1.  .. U IO X TIUPMTHD
  1.  .. U IO W $C(9)
  1.  .. ;
  1.  .. I $$TMPFL^BQIUL1("C") Q
  1.  .. I $$TMPFL^BQIUL1("R",UID,DFN) Q
  1.  .. ;
  1.  .. F  U IO R HSTEXT:.1 Q:HSTEXT[$C(9)  D
  1.  ... S HSTEXT=$$STRIP^XLFSTR(HSTEXT,"^"),HSTEXT=$$CTRL^BQIUL1(HSTEXT)
  1.  ... I HSTEXT="" S HSTEXT=" "
  1.  ... S BTI=BTI+1,@TDATA@(BTI)=HSTEXT
  1.  .. ;
  1.  .. I $$TMPFL^BQIUL1("C") Q
  1.  .. I $$TMPFL^BQIUL1("D",UID,DFN) Q
  1.  . S BN=0,QFL=0 F  S BN=$O(@TDATA@(BN)) Q:'BN!(QFL)  I @TDATA@(BN)["SUBJECT:" S NBN=BN,QFL=1
  1.  . S BN=NBN,QFL=0 F  S BN=$O(@TDATA@(BN)) Q:'BN!(QFL)  I @TDATA@(BN)["----------" S LBN=BN,QFL=1
  1.  . S FBN=LBN-1
  1.  . F BJ=NBN+1:1:$S(FBN<66:FBN,1:62) U IO W !,@TDATA@(BJ)
  1.  . I FBN>65 D
  1.  .. W @IOF
  1.  .. F BJ=63:1:FBN U IO W !,@TDATA@(BJ)
  1.  . W @IOF
  1.  K @TDATA
  1.  Q