- 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
