source: WorldVistAEHR/trunk/r/KERNEL-XU-A4A7-USC-XG-XLF-XNOA-XPD-XQ-XVIR-ZI-ZOSF-ZOSV-ZT-ZU-%Z-XIP--XQAB--XUC--XUR--ZIN--ZTED/ZISG2.m@ 1800

Last change on this file since 1800 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 4.7 KB
RevLine 
[613]1%ZISG2 ;SFISC/AC -- Device Handler Prototype
2 ;;8.0T3
3LOAD ;LOAD TMP ARRAY
4 S %=$G(^$E("WINDOW")) I $L(%) S %PARENT("PARENT")=%
5 I '$D(XGWIN) D PREP^XG
6 D GET^XGCLOAD("ZISG DEVICE W1","ZISGDEV","TMP")
7 D GET^XGCLOAD("ZISG DEVICE TRM","ZISGTRM","TMP")
8 D GET^XGCLOAD("ZISG DEVICE SPL","ZISGSPL","TMP")
9 D GET^XGCLOAD("ZISG DEVICE SDP","ZISGSDP","TMP")
10 D GET^XGCLOAD("ZISG DEVICE HFS","ZISGHFS","TMP")
11 D GET^XGCLOAD("ZISG DEVICE MT","ZISGMT","TMP")
12 S TMP("ZISGDEV","G","QDTIME","TITLE")=""
13 Q
14B1 ;OLD B1 CODE FROM ZISG ROUTINE
15 ;;I '^$W("ZISGDEV","G","PROMPT","VISIBLE") D
16 ;;.S ^$W("ZISGDEV","G","PROMPT","VALUE")=^$W("ZISGDEV","G","DEV","VALUE")
17 ;;.S ^$W("ZISGDEV","G","PROMPT","VISIBLE")=1
18 ;;.;S ^$W("ZISGDEV","G","QFRAME","VISIBLE")=0
19 ;;E D
20 ;;.S ^$W("ZISGDEV","G","PROMPT","VISIBLE")=0
21 ;;.;S ^$W("ZISGDEV","G","QFRAME","VISIBLE")=1
22 ;;.S ITEM=$O(^$W("ZISGDEV","G","PROMPT","VALUE",""))
23 ;;.I ITEM S ^$W("ZISGDEV","G","DEV","VALUE")=^$W("ZISGDEV","G","PROMPT","CHOICE",ITEM)
24 Q
25B2 ;;I '^$W("ZISGTRM","G","SUBTYPE","VISIBLE") D
26 ;;.S ^$W("ZISGTRM","G","SUBTYPE","VALUE")=^$W("ZISGTRM","G","SUB","VALUE")
27 ;;.;S ^$W("ZISGTRM","G","MARGIN","ACTIVE")=0
28 ;;.S ^$W("ZISGTRM","G","SUBTYPE","VISIBLE")=1
29 ;;E D
30 ;;.S ^$W("ZISGTRM","G","SUBTYPE","VISIBLE")=0
31 ;;.;S ^$W("ZISGTRM","G","MARGIN","ACTIVE")=1
32 ;;.S ITEM=$O(^$W("ZISGTRM","G","SUBTYPE","VALUE",""))
33 ;;.I ITEM S ^$W("ZISGTRM","G","SUB","VALUE")=^$W("ZISGTRM","G","SUBTYPE","CHOICE",ITEM)
34 Q
35OK ;Callbak for OK button.
36 N REF
37 S REF=XGWIN_"("""_@XGEVENT@("WINDOW")_""",""G"")"
38 S IOP=$S($G(@REF@("QUEUE","VALUE")):"Q;",1:"")
39 I $G(@REF@("QUEUE","VALUE")),$G(@REF@("QTIME","VALUE"))="NOW"!($G(@REF@("QDTIME","TITLE"))="") S ZTDTH=$H
40 S XGION=$S($D(@REF@("DEV","VALUE")):@REF@("DEV","VALUE"),1:"")
41 I XGION="" D ^XGLMSG("E","You have not selected a device.") Q
42 ;ENTER RETRIEVE TYPE INFO HERE:
43 S XGDA=""
44 I '$D(XGION) D
45 .S XGION=$S($D(^$W("ZISGDEV","G","DEV","VALUE")):^$W("ZISGDEV","G","DEV","VALUE"),1:"")
46 S:$G(XGION)]"" XGDA=$O(^%ZIS(1,"B",XGION,0))
47 S XGIOT=$G(^%ZIS(1,+XGDA,"TYPE"))
48 W !,"XGION==>>"_XGION
49 W !,"XGIOT==>>"_XGIOT
50 ;G @XGIOT
51TRM ;W:$D(@REF@("PROMPT","VALUE")) !,@REF@("PROMPT","VALUE"),@REF@("PROMPT","CHOICE",+$O(@REF@("PROMPT","VALUE","")))
52 S REF=XGWIN_"(""ZISGTRM"",""G"")"
53 W !,"REF==>>"_REF
54 ;
55 S XGIOST=$S($D(@REF@("SUB","VALUE")):@REF@("SUB","VALUE"),1:"")
56 W !,"SUB==>>"_XGIOST
57 ;W:$D(^$W("ZISGTRM","G","SUBTYPE","VALUE")) !,^$W("ZISGTRM","G","SUBTYPE","CHOICE",+$O(^$W("ZISGTRM","G","SUBTYPE","VALUE","")))
58 ;W:$D(@REF@("SUBTYPE","VALUE")) !,@REF@("SUBTYPE","VALUE"),@REF@("PROMPT","CHOICE",+$O(@REF@("SUBTYPE","VALUE","")))
59 ;
60 S XGIOM=$S($D(@REF@("MARGINVAL","VALUE")):@REF@("MARGINVAL","VALUE"),1:"")
61 W !,XGIOM
62 S XGIOSL=$S($D(@REF@("PAGELENGTHVAL","VALUE")):@REF@("PAGELENGTHVAL","VALUE"),1:"")
63 W !,XGIOSL
64 W !,"ZTDTH==>>"_$G(ZTDTH)
65 S IOP=IOP_XGION
66 I XGIOT="SPL" S %=0 D Q:%
67 .I '$D(DUZ) D ^XGLMSG("E","Your DUZ is not defined!") S %=1 Q
68 .I $S($D(^VA(200,DUZ,"SPL")):$E(^("SPL"),1),1:"N")'["y" D
69 ..D ^XGLMSG("E","You aren't an authorized SPOOLER user.") S %=1 Q
70 I XGIOT="SPL" S IOP=IOP_";"_XGDOC
71 S:XGIOST]"" IOP=IOP_";"_XGIOST
72 S:XGIOM]""!(XGIOSL]"") IOP=IOP_";"_XGIOM_";"_XGIOSL
73 W !,"IOP==>>"_IOP
74 S %ZIS="Q" D ^%ZIS
75 G ERRMSG:POP
76 ;ESTOP
77 D ESTO^XG
78 Q
79ERRMSG ;Pop-up error message.
80 D ^XGLMSG("E","THIS DEVICE IS BUSY")
81 Q
82QTIME ;
83 S X=^$W("ZISGDEV","G","QTIME","VALUE")
84 D ASK I Y=-1 D DTHLP Q
85 W !,"ZTDTH==>>"_ZTDTH
86 N %H
87 S %H=ZTDTH D YX^%DTC
88 S Y="("_Y_")"
89 S ^$W("ZISGDEV","G","QDTIME","TITLE")=Y
90 Q
91 ;
92ASK ;GET--ask for start time
93 I $D(ZTQUEUED) D:ZTDTH]"" Q
94 . S %DT="FRS",X=ZTDTH D ^%DT S ZTDTH=$$%H^%ZTLOAD2(+Y)
95 . Q
96 S %DT="RSX"
97 I $D(ZTNOGO) D NEXT^XQ92 I X="" D Q
98 .N %
99 .S %="Output is never allowed for this option!"
100 .D ^XGLMSG("W",%) S ZTDTH="" Q
101 I $D(ZTNOGO) S Y=X,%DT="S" D DD^%DT S %DT("B")=Y,%DT="RSX"
102 I $D(ZTNOGO),'$D(XQNOGO) D
103 .N %
104 .S %="Output from this option is restricted during certain times"
105 .D ^XGLMSG("W",%)
106 D ^%DT I $D(ZTNOGO) D
107 .S ZT=Y,X=Y
108 .D ^XQ92 S Y=ZT Q:X]""
109 .N % S %="That is a restricted time!"
110 .D ^XGLMSG("W",%)
111 K %DT,%T,X5
112 S ZTDTH=$$%H^%ZTLOAD2(+Y) Q
113 Q
114DTHLP ;Help for Date input
115 N I
116 F I=1:1 S Y=$T(Z+I) Q:Y="" S %(I)=$P(Y,";",3,999)
117 K ^$EVENT("OK")
118 D ^XGLMSG("I",.%)
119 W !,^$DI($PD,"FOCUS")
120 S ^$DI($PD,"FOCUS")="ZISGDEV,QTIME"
121 Q
122Z ;
123 ;;Examples of Valid Dates:
124 ;; JAN 20 1957 or 20 JAN 57 or 1/20/57 or 012057
125 ;; T (for TODAY), T+1 (for TOMORROW), T+2, T+7, etc.
126 ;; T-1 (for YESTERDAY), T-3W (for 3 WEEKS AGO), etc.
127 ;;If the year is omitted, the computer uses the CURRENT YEAR.
128 ;;If the date is omitted, the current date is assumed.
129 ;;Follow the date with a time, such as JAN 20@10, T@10AM, 10:30, etc.
130 ;;You may enter a time, such as NOON, MIDNIGHT or NOW.
131 ;;Seconds may be entered as 10:30:30 or 103030AM.
132 ;;Time is REQUIRED in this response.
Note: See TracBrowser for help on using the repository browser.