CIAVUTIO ;MSC/IND/DKM - VueCentric Host IO Support ;04-May-2006 08:19;DKM
;;1.1V2;VUECENTRIC FRAMEWORK;;Mar 20, 2007
;;Copyright 2000-2006, Medsphere Systems Corporation
;=================================================================
; Capture output to HFS and redirect to global
OUTPUT(EXEC,ROOT,RM) ;
D CAPTURE^CIAUHFS(.EXEC,.ROOT,.RM)
Q
; Print report to specified device. Supports multiple calls to
; build large reports before printing. Specifying DEV parameter
; signals the report is complete and ready to print.
; CTL = Unique handle for this report. Pass 0 on initial call.
; RPT = Array containing block of report text
; DEV = IEN of output device (pass on final call only)
; or negative value to abort print
; TTL = Title of report (default=none)
; BRK = Line break placeholder (default=none)
; IND = Left indent (default=none)
; DATA = Unique handle assigned to this report or, if this is
; final call, the id # of the submitted task.
PRINT(DATA,CTL,RPT,DEV,TTL,BRK,IND) ;
N X,SB,$ET
S SB="CIAVUTIO."_$S($G(CIA("UID")):CIA("UID"),1:"J"_$J)
S $ET="",@$$TRAP^CIAUOS("PRERR^CIAVUTIO")
I '$G(CTL) D ; Initialize report buffer
.L +^XTMP(SB):5
.S ^XTMP(SB,0)=$$FMADD^XLFDT(DT,2)_U_DT,CTL=$O(^(""),-1)+1,^(CTL)=""
.L -^XTMP(SB)
S DATA=CTL,X=$O(^XTMP(SB,CTL,""),-1)+1 ; X = current block #
M ^XTMP(SB,CTL,X)=RPT ; Copy the current block
Q:'$G(DEV)
I DEV<0 K ^XTMP(SB,CTL)
E S DATA=$$QUEUE^CIAUTSK("PRTASK^CIAVUTIO",$G(TTL,"Print Job #"_CTL),,"BRK^IND^CTL^SB","`"_+DEV)
Q
; Entry point for tasked print job
PRTASK N X,Y,Z,$ET
U IO
S IND=$$REPEAT^XLFSTR(" ",+$G(IND)),X=0,$ET="",@$$TRAP^CIAUOS("PRERR^CIAVUTIO")
F S X=$O(^XTMP(SB,CTL,X)),Y=0 Q:'X D
.F S Y=$O(^XTMP(SB,CTL,X,Y)) Q:'Y S Z=^(Y) D
..I $L(BRK),Z=BRK W @IOF,!
..E W IND,Z,!
K ^XTMP(SB,CTL)
S IO("C")=""
D ^%ZISC
S ZTREQ="@"
Q
; Exception handler for print errors
PRERR K ^XTMP(SB,CTL)
D ^%ZTER
Q
; Local printer is default?
PRTISLCL(DATA,LOC) ;
D PRTGETDF(.DATA,.LOC)
S DATA=$S('$L(DATA):0,1:'DATA)
Q
; Returns current default printer for user
PRTGETDF(DATA,LOC) ;
N IEN,DEV,ENT
S ENT="ALL"
S:$G(LOC) LOC=+LOC_";SC(",ENT=ENT_U_LOC
S DATA=$$GET^XPAR(ENT,"CIAVUTIO DEFAULT PRINTER",1),IEN=+DATA
S:IEN $P(DATA,";",2)=$P($G(^%ZIS(1,IEN,0)),U)
Q
; Save new default printer for user
PRTSETDF(DATA,DEV) ;
D EN^XPAR("USR","CIAVUTIO DEFAULT PRINTER",1,DEV,.DATA)
Q
; Return a subset of entries from the Device file
; DATA(n)=IEN;Name^DisplayName^Location^RMar^PLen
DEVICE(DATA,FROM,DIR,MAX) ;
N CNT,IEN,X,Y,X0,XLOC,XSEC,XTYPE,XSTYPE,XTIME,XOSD,MW,PL,DEV
S CNT=0,MAX=$G(MAX,20)
S:FROM[" <" FROM=$RE($P($RE(FROM),"< ",2))
F Q:CNT'<MAX S FROM=$O(^%ZIS(1,"B",FROM),DIR),IEN=0 Q:FROM="" D
.F S IEN=$O(^%ZIS(1,"B",FROM,IEN)) Q:'IEN D
..S DEV="",X0=$G(^%ZIS(1,IEN,0)),XLOC=$P($G(^(1)),U),XOSD=+$G(^(90)),MW=$G(^(91)),XSEC=$G(^(95)),XSTYPE=+$G(^("SUBTYPE")),XTIME=$P($G(^("TIME")),U),XTYPE=$P($G(^("TYPE")),U)
..Q:$E($G(^%ZIS(2,XSTYPE,0)))'="P" ; Printers only
..Q:"^TRM^HG^CHAN^OTH^"'[(U_XTYPE_U)
..Q:$P(X0,U,2)="0"!($P(X0,U,12)=2) ; Queuing allowed
..I XOSD,XOSD'>DT Q ; Out of Service
..I $L(XTIME) D Q:'$L(XTIME) ; Prohibited Times
...S Y=$P($H,",",2),Y=Y\60#60+(Y\3600*100),X=$P(XTIME,"-",2)
...S:X'<XTIME&(Y'>X&(Y'<XTIME))!(X<XTIME&(Y'<XTIME!(Y'>X))) XTIME=""
..I $L(XSEC),$G(DUZ(0))'="@",$TR(XSEC,$G(DUZ(0)))=XSEC Q
..S PL=$P(MW,U,3),MW=$P(MW,U),X=$G(^%ZIS(2,XSTYPE,1))
..S:'MW MW=$P(X,U)
..S:'PL PL=$P(X,U,3)
..S X=$P(X0,U)
..Q:$E(X,1,4)["NULL"
..S:X'=FROM X=FROM_" <"_X_">"
..S CNT=CNT+1,DATA(CNT)=IEN_";"_$P(X0,U)_U_X_U_XLOC_U_MW_U_PL
Q
; Preopen code for tech support device
TSOPEN S %ZIS("HFSNAME")=$$PWD^%ZISH_$$UFN^CIAU,%ZIS("HFSMODE")="W",%ZTYPE="HFS"
S ^TMP("CIAVUTIO",$J)=%ZIS("HFSNAME")
Q
; Postclose code for tech support device
TSCLOSE N DATA,HFS,SUB
S HFS=$G(^TMP("CIAVUTIO",$J)),SUB=$G(^($J,"SUB"),"VUECENTRIC TECH SUPPORT REQUEST")
Q:'$L(HFS)
K ^TMP("CIAVUTIO",$J) S DATA=$NA(^($J,1))
I $$FTG^%ZISH(HFS,"",DATA,3) D
.N XMTEXT,XMY,XMSUB,XMDUZ
.S XMTEXT="^TMP(""CIAVUTIO"",$J,",XMDUZ=DUZ,XMY="G.VUECENTRIC TECH SUPPORT",XMSUB=SUB
.D ^XMD
K DATA,^TMP("CIAVUTIO",$J)
S DATA(HFS)=""
I $$DEL^%ZISH("","DATA")
Q
CIAVUTIO ;MSC/IND/DKM - VueCentric Host IO Support ;04-May-2006 08:19;DKM
+1 ;;1.1V2;VUECENTRIC FRAMEWORK;;Mar 20, 2007
+2 ;;Copyright 2000-2006, Medsphere Systems Corporation
+3 ;=================================================================
+4 ; Capture output to HFS and redirect to global
OUTPUT(EXEC,ROOT,RM) ;
+1 DO CAPTURE^CIAUHFS(.EXEC,.ROOT,.RM)
+2 QUIT
+3 ; Print report to specified device. Supports multiple calls to
+4 ; build large reports before printing. Specifying DEV parameter
+5 ; signals the report is complete and ready to print.
+6 ; CTL = Unique handle for this report. Pass 0 on initial call.
+7 ; RPT = Array containing block of report text
+8 ; DEV = IEN of output device (pass on final call only)
+9 ; or negative value to abort print
+10 ; TTL = Title of report (default=none)
+11 ; BRK = Line break placeholder (default=none)
+12 ; IND = Left indent (default=none)
+13 ; DATA = Unique handle assigned to this report or, if this is
+14 ; final call, the id # of the submitted task.
PRINT(DATA,CTL,RPT,DEV,TTL,BRK,IND) ;
+1 NEW X,SB,$ETRAP
+2 SET SB="CIAVUTIO."_$SELECT($GET(CIA("UID")):CIA("UID"),1:"J"_$JOB)
+3 SET $ETRAP=""
SET @$$TRAP^CIAUOS("PRERR^CIAVUTIO")
+4 ; Initialize report buffer
IF '$GET(CTL)
Begin DoDot:1
+5 LOCK +^XTMP(SB):5
+6 SET ^XTMP(SB,0)=$$FMADD^XLFDT(DT,2)_U_DT
SET CTL=$ORDER(^(""),-1)+1
SET ^(CTL)=""
+7 LOCK -^XTMP(SB)
End DoDot:1
+8 ; X = current block #
SET DATA=CTL
SET X=$ORDER(^XTMP(SB,CTL,""),-1)+1
+9 ; Copy the current block
MERGE ^XTMP(SB,CTL,X)=RPT
+10 IF '$GET(DEV)
QUIT
+11 IF DEV<0
KILL ^XTMP(SB,CTL)
+12 IF '$TEST
SET DATA=$$QUEUE^CIAUTSK("PRTASK^CIAVUTIO",$GET(TTL,"Print Job #"_CTL),,"BRK^IND^CTL^SB","`"_+DEV)
+13 QUIT
+14 ; Entry point for tasked print job
PRTASK NEW X,Y,Z,$ETRAP
+1 USE IO
+2 SET IND=$$REPEAT^XLFSTR(" ",+$GET(IND))
SET X=0
SET $ETRAP=""
SET @$$TRAP^CIAUOS("PRERR^CIAVUTIO")
+3 FOR
SET X=$ORDER(^XTMP(SB,CTL,X))
SET Y=0
IF 'X
QUIT
Begin DoDot:1
+4 FOR
SET Y=$ORDER(^XTMP(SB,CTL,X,Y))
IF 'Y
QUIT
SET Z=^(Y)
Begin DoDot:2
+5 IF $LENGTH(BRK)
IF Z=BRK
WRITE @IOF,!
+6 IF '$TEST
WRITE IND,Z,!
End DoDot:2
End DoDot:1
+7 KILL ^XTMP(SB,CTL)
+8 SET IO("C")=""
+9 DO ^%ZISC
+10 SET ZTREQ="@"
+11 QUIT
+12 ; Exception handler for print errors
PRERR KILL ^XTMP(SB,CTL)
+1 DO ^%ZTER
+2 QUIT
+3 ; Local printer is default?
PRTISLCL(DATA,LOC) ;
+1 DO PRTGETDF(.DATA,.LOC)
+2 SET DATA=$SELECT('$LENGTH(DATA):0,1:'DATA)
+3 QUIT
+4 ; Returns current default printer for user
PRTGETDF(DATA,LOC) ;
+1 NEW IEN,DEV,ENT
+2 SET ENT="ALL"
+3 IF $GET(LOC)
SET LOC=+LOC_";SC("
SET ENT=ENT_U_LOC
+4 SET DATA=$$GET^XPAR(ENT,"CIAVUTIO DEFAULT PRINTER",1)
SET IEN=+DATA
+5 IF IEN
SET $PIECE(DATA,";",2)=$PIECE($GET(^%ZIS(1,IEN,0)),U)
+6 QUIT
+7 ; Save new default printer for user
PRTSETDF(DATA,DEV) ;
+1 DO EN^XPAR("USR","CIAVUTIO DEFAULT PRINTER",1,DEV,.DATA)
+2 QUIT
+3 ; Return a subset of entries from the Device file
+4 ; DATA(n)=IEN;Name^DisplayName^Location^RMar^PLen
DEVICE(DATA,FROM,DIR,MAX) ;
+1 NEW CNT,IEN,X,Y,X0,XLOC,XSEC,XTYPE,XSTYPE,XTIME,XOSD,MW,PL,DEV
+2 SET CNT=0
SET MAX=$GET(MAX,20)
+3 IF FROM[" <"
SET FROM=$REVERSE($PIECE($REVERSE(FROM),"< ",2))
+4 FOR
IF CNT'<MAX
QUIT
SET FROM=$ORDER(^%ZIS(1,"B",FROM),DIR)
SET IEN=0
IF FROM=""
QUIT
Begin DoDot:1
+5 FOR
SET IEN=$ORDER(^%ZIS(1,"B",FROM,IEN))
IF 'IEN
QUIT
Begin DoDot:2
+6 SET DEV=""
SET X0=$GET(^%ZIS(1,IEN,0))
SET XLOC=$PIECE($GET(^(1)),U)
SET XOSD=+$GET(^(90))
SET MW=$GET(^(91))
SET XSEC=$GET(^(95))
SET XSTYPE=+$GET(^("SUBTYPE"))
SET XTIME=$PIECE($GET(^("TIME")),U)
SET XTYPE=$PIECE($GET(^("TYPE")),U)
+7 ; Printers only
IF $EXTRACT($GET(^%ZIS(2,XSTYPE,0)))'="P"
QUIT
+8 IF "^TRM^HG^CHAN^OTH^"'[(U_XTYPE_U)
QUIT
+9 ; Queuing allowed
IF $PIECE(X0,U,2)="0"!($PIECE(X0,U,12)=2)
QUIT
+10 ; Out of Service
IF XOSD
IF XOSD'>DT
QUIT
+11 ; Prohibited Times
IF $LENGTH(XTIME)
Begin DoDot:3
+12 SET Y=$PIECE($HOROLOG,",",2)
SET Y=Y\60#60+(Y\3600*100)
SET X=$PIECE(XTIME,"-",2)
+13 IF X'<XTIME&(Y'>X&(Y'<XTIME))!(X<XTIME&(Y'<XTIME!(Y'>X)))
SET XTIME=""
End DoDot:3
IF '$LENGTH(XTIME)
QUIT
+14 IF $LENGTH(XSEC)
IF $GET(DUZ(0))'="@"
IF $TRANSLATE(XSEC,$GET(DUZ(0)))=XSEC
QUIT
+15 SET PL=$PIECE(MW,U,3)
SET MW=$PIECE(MW,U)
SET X=$GET(^%ZIS(2,XSTYPE,1))
+16 IF 'MW
SET MW=$PIECE(X,U)
+17 IF 'PL
SET PL=$PIECE(X,U,3)
+18 SET X=$PIECE(X0,U)
+19 IF $EXTRACT(X,1,4)["NULL"
QUIT
+20 IF X'=FROM
SET X=FROM_" <"_X_">"
+21 SET CNT=CNT+1
SET DATA(CNT)=IEN_";"_$PIECE(X0,U)_U_X_U_XLOC_U_MW_U_PL
End DoDot:2
End DoDot:1
+22 QUIT
+23 ; Preopen code for tech support device
TSOPEN SET %ZIS("HFSNAME")=$$PWD^%ZISH_$$UFN^CIAU
SET %ZIS("HFSMODE")="W"
SET %ZTYPE="HFS"
+1 SET ^TMP("CIAVUTIO",$JOB)=%ZIS("HFSNAME")
+2 QUIT
+3 ; Postclose code for tech support device
TSCLOSE NEW DATA,HFS,SUB
+1 SET HFS=$GET(^TMP("CIAVUTIO",$JOB))
SET SUB=$GET(^($JOB,"SUB"),"VUECENTRIC TECH SUPPORT REQUEST")
+2 IF '$LENGTH(HFS)
QUIT
+3 KILL ^TMP("CIAVUTIO",$JOB)
SET DATA=$NAME(^($JOB,1))
+4 IF $$FTG^%ZISH(HFS,"",DATA,3)
Begin DoDot:1
+5 NEW XMTEXT,XMY,XMSUB,XMDUZ
+6 SET XMTEXT="^TMP(""CIAVUTIO"",$J,"
SET XMDUZ=DUZ
SET XMY="G.VUECENTRIC TECH SUPPORT"
SET XMSUB=SUB
+7 DO ^XMD
End DoDot:1
+8 KILL DATA,^TMP("CIAVUTIO",$JOB)
+9 SET DATA(HFS)=""
+10 IF $$DEL^%ZISH("","DATA")
+11 QUIT
