XQSRV2.m

XQSRV2 ;SEA/MJM - Server Task handler ;11/19/93  10:55 ;4/9/92  11:14 AM [ 04/02/2003   8:29 AM ]

 ;;8.0;KERNEL;**1002,1003,1004,1005,1007**;APR 1, 2003

 ;;8.0;KERNEL;;Jul 10, 1995

 ;

AUDIT ;If audit is required fill in the data (AUDIT #2) the results.

 D ^XQDATE S XQDONE=%

 I XQMB6="  " S XQMB6="No errors reported by the Menu System."

 S $P(^XUSEC(19,XQLTL,0),U,5)=XQDONE

 S ^XUSEC(19,XQLTL,3)=XQMB6

 Q

 ;

ZTSK ;Server Taskman Entry

 S U="^",X="ERROR^XQSRV2",@^%ZOSF("TRAP")

 ;

RUN ;Do first audit, save off what I need, and clean out partition

 D:XQAUDIT AUDIT^XQSRV1

 F %="XMCHAN","XMFROM","XMREC","XMXX" S ^XUTL("XQ",$J,%)=@%

 F %="XQ220","XQAUDIT","XQDATE","XQLTL","XQMB","XQMB6","XQMSG","XQNOUSR","XQREPLY","XQRTN","XQSND","XQSOP","XQSUB","XQSUP" S ^XUTL("XQ",$J,%)=@%

 D KILL^XUSCLEAN

 S (XQER,XQER1)=""

 F %="XMCHAN","XMFROM","XMREC","XMXX" S @%=^XUTL("XQ",$J,%)

 F %="XQ220","XQAUDIT","XQDATE","XQLTL","XQMB","XQMB6","XQMSG","XQNOUSR","XQREPLY","XQRTN","XQSND","XQSOP","XQSUB","XQSUP" S @%=^XUTL("XQ",$J,%)

 S XMZ=XQMSG S:'$D(XMFROM) XMFROM=XQSND

 ;

 S XQER="Entry Action: "

 I $D(^DIC(19,+XQY,20))#2,$L(^(20)) X ^(20) I $D(XQUIT) S XQER="XQUIT variable encountered after Entry Action.  Routine not run." G OUT

 ;

 S XQER="Header: "

 I $D(^DIC(19,+XQY,26))#2,$L(^(26)) X ^(26)

 ;

 S XQER="Routine "_XQRTN_": "

 I XQRTN'=U S:'$D(XMZ) XMZ=^XUTL("XQ",$J,"XQMSG") D @XQRTN

 ;

 S XQER="Exit Action: "

 I $D(^DIC(19,+XQY,15))#2,$L(^(15)) X ^(15)

 ;

 S:XQER1="" XQER=""

 F %="XMCHAN","XMFROM","XMREC","XMXX" S @%=^XUTL("XQ",$J,%)

 F %="XQ220","XQAUDIT","XQDATE","XQLTL","XQMB","XQMB6","XQMSG","XQNOUSR","XQREPLY","XQRTN","XQSND","XQSOP","XQSUB","XQSUP" S @%=^XUTL("XQ",$J,%)

 ;

OUT ;Clean up and quit

 S:'$D(XQMB6) XQMB6="" S XQMB6=XQMB6_" "_XQER_" "_XQER1 S:XQMB6[";;" XQMB6=$P(XQMB6,";;",2)

 I 'XQNOUSR,(XQSUP'="Y") D BULL^XQSRV4

 I XQREPLY="R"!(XQREPLY="E"&(XQER]""))!(XQREPLY="E"&(XQER1]"")) D ^XQSRV3

 D:XQNOUSR NOUSER^XQSRV3

 D:XQAUDIT AUDIT

 ;

KILL ;Pass Mailman back variables and kill off XQ's

 S XM1Z=XQMSG,XMXX="S."_XQSOP,XMB("TYPE")=5

 I XQER]""!(XQER1]"") S %=XQER_XQER1,XQSRVOK=$E(%,1,30)

 ;

 K %,%Y,DIC,X,XQ,XQ220,XQAUDIT,XQBUL,XQCHK,XQDATE,XQDONE,XQDT,XQDTH,XQEND,XQER,XQER1,XQHERE,XQI,XQII,XQJ,XQLTL,XQMB,XQMD,XQMS,XQMSG

 K XQN,XQNOBUL,XQNOUSR,XQREPLY,XQRES,XQRTN,XQSND,XQSOP,XQSRV,XQSTART,XQSTXT,XQSUB,XQSUP,XQUIT,XQVOL,XQX,XQY,XQY0,XQZ,Y,ZTSK

 K ^XUTL("XQ",$J)

 Q

 ;

ERROR ;Figure out the error message, load it in XQER, and call ^%ZTER

 I $D(^XUTL("XQ",$J,"XMCHAN")) F %="XMCHAN","XMFROM","XMREC","XMXX" S @%=^(%)

 I $D(^XUTL("XQ",$J,"XQ220")) F %="XQ220","XQAUDIT","XQDATE","XQLTL","XQMB","XQMB6","XQMSG","XQNOUSR","XQREPLY","XQRTN","XQSND","XQSOP","XQSUB","XQSUP" S @%=^(%)

 S XQER1=$E($ZE,1,70)

 S %ZTERLGR=$$LGR^%ZOSV D ^%ZTER

 G OUT

 Q

XQSRV2    ;SEA/MJM - Server Task handler ;11/19/93  10:55 ;4/9/92  11:14 AM [ 04/02/2003   8:29 AM ]

 +1       ;;8.0;KERNEL;**1002,1003,1004,1005,1007**;APR 1, 2003

 +2       ;;8.0;KERNEL;;Jul 10, 1995

 +3       ;

AUDIT     ;If audit is required fill in the data (AUDIT #2) the results.

 +1        DO ^XQDATE

           SET XQDONE=%

 +2        IF XQMB6="  "

               SET XQMB6="No errors reported by the Menu System."

 +3        SET $PIECE(^XUSEC(19,XQLTL,0),U,5)=XQDONE

 +4        SET ^XUSEC(19,XQLTL,3)=XQMB6

 +5        QUIT 

 +6       ;

ZTSK      ;Server Taskman Entry

 +1        SET U="^"

           SET X="ERROR^XQSRV2"

           SET @^%ZOSF("TRAP")

 +2       ;

RUN       ;Do first audit, save off what I need, and clean out partition

 +1        IF XQAUDIT

               DO AUDIT^XQSRV1

 +2        FOR %="XMCHAN","XMFROM","XMREC","XMXX"

               SET ^XUTL("XQ",$JOB,%)=@%

 +3        FOR %="XQ220","XQAUDIT","XQDATE","XQLTL","XQMB","XQMB6","XQMSG","XQNOUSR","XQREPLY","XQRTN","XQSND","XQSOP","XQSUB","XQSUP"

               SET ^XUTL("XQ",$JOB,%)=@%

 +4        DO KILL^XUSCLEAN

 +5        SET (XQER,XQER1)=""

 +6        FOR %="XMCHAN","XMFROM","XMREC","XMXX"

               SET @%=^XUTL("XQ",$JOB,%)

 +7        FOR %="XQ220","XQAUDIT","XQDATE","XQLTL","XQMB","XQMB6","XQMSG","XQNOUSR","XQREPLY","XQRTN","XQSND","XQSOP","XQSUB","XQSUP"

               SET @%=^XUTL("XQ",$JOB,%)

 +8        SET XMZ=XQMSG

           IF '$DATA(XMFROM)

               SET XMFROM=XQSND

 +9       ;

 +10       SET XQER="Entry Action: "

 +11       IF $DATA(^DIC(19,+XQY,20))#2

               IF $LENGTH(^(20))

                   XECUTE ^(20)

                   IF $DATA(XQUIT)

                       SET XQER="XQUIT variable encountered after Entry Action.  Routine not run."

                       GOTO OUT

 +12      ;

 +13       SET XQER="Header: "

 +14       IF $DATA(^DIC(19,+XQY,26))#2

               IF $LENGTH(^(26))

                   XECUTE ^(26)

 +15      ;

 +16       SET XQER="Routine "_XQRTN_": "

 +17       IF XQRTN'=U

               IF '$DATA(XMZ)

                   SET XMZ=^XUTL("XQ",$JOB,"XQMSG")

               DO @XQRTN

 +18      ;

 +19       SET XQER="Exit Action: "

 +20       IF $DATA(^DIC(19,+XQY,15))#2

               IF $LENGTH(^(15))

                   XECUTE ^(15)

 +21      ;

 +22       IF XQER1=""

               SET XQER=""

 +23       FOR %="XMCHAN","XMFROM","XMREC","XMXX"

               SET @%=^XUTL("XQ",$JOB,%)

 +24       FOR %="XQ220","XQAUDIT","XQDATE","XQLTL","XQMB","XQMB6","XQMSG","XQNOUSR","XQREPLY","XQRTN","XQSND","XQSOP","XQSUB","XQSUP"

               SET @%=^XUTL("XQ",$JOB,%)

 +25      ;

OUT       ;Clean up and quit

 +1        IF '$DATA(XQMB6)

               SET XQMB6=""

           SET XQMB6=XQMB6_" "_XQER_" "_XQER1

           IF XQMB6[";;"

               SET XQMB6=$PIECE(XQMB6,";;",2)

 +2        IF 'XQNOUSR

               IF (XQSUP'="Y")

                   DO BULL^XQSRV4

 +3        IF XQREPLY="R"!(XQREPLY="E"&(XQER]""))!(XQREPLY="E"&(XQER1]""))

               DO ^XQSRV3

 +4        IF XQNOUSR

               DO NOUSER^XQSRV3

 +5        IF XQAUDIT

               DO AUDIT

 +6       ;

KILL      ;Pass Mailman back variables and kill off XQ's

 +1        SET XM1Z=XQMSG

           SET XMXX="S."_XQSOP

           SET XMB("TYPE")=5

 +2        IF XQER]""!(XQER1]"")

               SET %=XQER_XQER1

               SET XQSRVOK=$EXTRACT(%,1,30)

 +3       ;

 +4        KILL %,%Y,DIC,X,XQ,XQ220,XQAUDIT,XQBUL,XQCHK,XQDATE,XQDONE,XQDT,XQDTH,XQEND,XQER,XQER1,XQHERE,XQI,XQII,XQJ,XQLTL,XQMB,XQMD,XQMS,XQMSG

 +5        KILL XQN,XQNOBUL,XQNOUSR,XQREPLY,XQRES,XQRTN,XQSND,XQSOP,XQSRV,XQSTART,XQSTXT,XQSUB,XQSUP,XQUIT,XQVOL,XQX,XQY,XQY0,XQZ,Y,ZTSK

 +6        KILL ^XUTL("XQ",$JOB)

 +7        QUIT 

 +8       ;

ERROR     ;Figure out the error message, load it in XQER, and call ^%ZTER

 +1        IF $DATA(^XUTL("XQ",$JOB,"XMCHAN"))

               FOR %="XMCHAN","XMFROM","XMREC","XMXX"

                   SET @%=^(%)

 +2        IF $DATA(^XUTL("XQ",$JOB,"XQ220"))

               FOR %="XQ220","XQAUDIT","XQDATE","XQLTL","XQMB","XQMB6","XQMSG","XQNOUSR","XQREPLY","XQRTN","XQSND","XQSOP","XQSUB","XQSUP"

                   SET @%=^(%)

 +3        SET XQER1=$EXTRACT($ZE,1,70)

 +4        SET %ZTERLGR=$$LGR^%ZOSV

           DO ^%ZTER

 +5        GOTO OUT

 +6        QUIT