VAQDIS17 ;ALB/JFP - PDX,DEVICE SELECTER FOR DISPLAY;01MAR93
;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993
DEVICE(TYPE) ; -- Gets device
ASK S %ZIS="MNQ" D ^%ZIS I POP D EXIT Q -1
I IOM<80 D ^%ZISC W !!,$C(7),"RIGHT MARGIN MUST BE AT LEAST 80",!! G ASK
I POP D EXIT QUIT -1
; -- output to screen
I IO=IO(0) K %ZIS QUIT 1
; -- Task to device
I IO'=IO(0) D QUEUE,EXIT Q 0
QUIT 0
;
QUEUE ;QUEUE FOR PRINTING
S ZTRTN="TASK^VAQDIS17",ZTIO=ION,ZTDTH=$H
S ZTDESC="Print list PDX"
F X="DFN","VALMCC","TYPE","^TMP(""VAQIDX"",$J,","^TMP(""VAQIDXSG"",$J,","VALMY(" S ZTSAVE(X)=""
D SAVE^VALM1,^%ZTLOAD
D PRTLQ^VALM1
I $D(ZTSK) W !!,"Output Queued - Task number = ",ZTSK D PAUSE^VAQUTL95
;D:'$D(ZTQUEUED) ^%ZISC
QUIT
;
TASK ; -- Task for printing
I TYPE="ALL" D ALL S:$D(ZTQUEUED) ZTREQ="@" QUIT
I TYPE="SEL" D SELECT S:$D(ZTQUEUED) ZTREQ="@" QUIT
QUIT
;
ALL ; -- Builds display for all segments
S ENTRY="",VALMCNT=0,ROOT="^TMP(""VAQD3"",$J)" K @ROOT
F S ENTRY=$O(^TMP("VAQIDXSG",$J,ENTRY)) Q:ENTRY="" D BLDDIS^VAQDIS15 Q:$$S^%ZTLOAD
Q:$$S^%ZTLOAD
D BLD
; W @IOF
D ^%ZISC
ALLQ QUIT
;
SELECT ; -- Builds display for selected segments
S ENTRY="",VALMCNT=0,ROOT="^TMP(""VAQD3"",$J)" K @ROOT
F S ENTRY=$O(VALMY(ENTRY)) Q:ENTRY="" D BLDDIS^VAQDIS15 Q:$$S^%ZTLOAD
Q:$$S^%ZTLOAD
D BLD
; W @IOF
D ^%ZISC
SELQ QUIT
;
BLD ; -- Builds printed output
D ENDLN^VAQDIS15
S NROOT="^TMP(""VAQD3"",$J)"
N VALMAR
S VALMAR=$$ROOT^VAQDIS20(NROOT)
D CHGCAP^VALM("ENTRY","")
D CHGCAP^VALM("SEGMENTS","")
D CHGCAP^VALM("SEGNAME","")
D PRTLS^VALM1 ; -- list processor routine
QUIT
;
EXIT ; -- Kill device/queue variables
K ZTSK,%ZIS,ZTRTN,ZTIO,ZTDESC,ZTSAVE
K DTOUT,DUOUT,DIRUT,DIROUT
K ROOT
QUIT
END ; -- End of code
QUIT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVAQDIS17 1801 printed Nov 22, 2024@17:35:24 Page 2
VAQDIS17 ;ALB/JFP - PDX,DEVICE SELECTER FOR DISPLAY;01MAR93
+1 ;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993
DEVICE(TYPE) ; -- Gets device
ASK SET %ZIS="MNQ"
DO ^%ZIS
IF POP
DO EXIT
QUIT -1
+1 IF IOM<80
DO ^%ZISC
WRITE !!,$CHAR(7),"RIGHT MARGIN MUST BE AT LEAST 80",!!
GOTO ASK
+2 IF POP
DO EXIT
QUIT -1
+3 ; -- output to screen
+4 IF IO=IO(0)
KILL %ZIS
QUIT 1
+5 ; -- Task to device
+6 IF IO'=IO(0)
DO QUEUE
DO EXIT
QUIT 0
+7 QUIT 0
+8 ;
QUEUE ;QUEUE FOR PRINTING
+1 SET ZTRTN="TASK^VAQDIS17"
SET ZTIO=ION
SET ZTDTH=$HOROLOG
+2 SET ZTDESC="Print list PDX"
+3 FOR X="DFN","VALMCC","TYPE","^TMP(""VAQIDX"",$J,","^TMP(""VAQIDXSG"",$J,","VALMY("
SET ZTSAVE(X)=""
+4 DO SAVE^VALM1
DO ^%ZTLOAD
+5 DO PRTLQ^VALM1
+6 IF $DATA(ZTSK)
WRITE !!,"Output Queued - Task number = ",ZTSK
DO PAUSE^VAQUTL95
+7 ;D:'$D(ZTQUEUED) ^%ZISC
+8 QUIT
+9 ;
TASK ; -- Task for printing
+1 IF TYPE="ALL"
DO ALL
if $DATA(ZTQUEUED)
SET ZTREQ="@"
QUIT
+2 IF TYPE="SEL"
DO SELECT
if $DATA(ZTQUEUED)
SET ZTREQ="@"
QUIT
+3 QUIT
+4 ;
ALL ; -- Builds display for all segments
+1 SET ENTRY=""
SET VALMCNT=0
SET ROOT="^TMP(""VAQD3"",$J)"
KILL @ROOT
+2 FOR
SET ENTRY=$ORDER(^TMP("VAQIDXSG",$JOB,ENTRY))
if ENTRY=""
QUIT
DO BLDDIS^VAQDIS15
if $$S^%ZTLOAD
QUIT
+3 if $$S^%ZTLOAD
QUIT
+4 DO BLD
+5 ; W @IOF
+6 DO ^%ZISC
ALLQ QUIT
+1 ;
SELECT ; -- Builds display for selected segments
+1 SET ENTRY=""
SET VALMCNT=0
SET ROOT="^TMP(""VAQD3"",$J)"
KILL @ROOT
+2 FOR
SET ENTRY=$ORDER(VALMY(ENTRY))
if ENTRY=""
QUIT
DO BLDDIS^VAQDIS15
if $$S^%ZTLOAD
QUIT
+3 if $$S^%ZTLOAD
QUIT
+4 DO BLD
+5 ; W @IOF
+6 DO ^%ZISC
SELQ QUIT
+1 ;
BLD ; -- Builds printed output
+1 DO ENDLN^VAQDIS15
+2 SET NROOT="^TMP(""VAQD3"",$J)"
+3 NEW VALMAR
+4 SET VALMAR=$$ROOT^VAQDIS20(NROOT)
+5 DO CHGCAP^VALM("ENTRY","")
+6 DO CHGCAP^VALM("SEGMENTS","")
+7 DO CHGCAP^VALM("SEGNAME","")
+8 ; -- list processor routine
DO PRTLS^VALM1
+9 QUIT
+10 ;
EXIT ; -- Kill device/queue variables
+1 KILL ZTSK,%ZIS,ZTRTN,ZTIO,ZTDESC,ZTSAVE
+2 KILL DTOUT,DUOUT,DIRUT,DIROUT
+3 KILL ROOT
+4 QUIT
END ; -- End of code
+1 QUIT
