PRSAUTL ; HISC/REL-Utilities ;6/4/93 11:19
;;4.0;PAID;**21**;Sep 21, 1995
S USR="",SSN=$P($G(^VA(200,DUZ,1)),"^",9)
I SSN="" W !!,*7,"Your SSN was not found in the New Person File!" S TLI="" Q
S USR=$O(^PRSPC("SSN",SSN,0))
TL ; Select T&L from among those allowed
K DIC I PRSTLV>5 G P1
S Z1=$S(PRSTLV=2:"T",PRSTLV="3":"S",1:"*")
S TLI=$O(^PRST(455.5,"A"_Z1,DUZ,0)) I TLI<1 W !!,*7,"No T&L Units have been assigned to you!" Q
I $O(^PRST(455.5,"A"_Z1,DUZ,TLI))<1 G P2
S DIC("S")="I $D(^PRST(455.5,+Y,Z1,DUZ))"
P1 S DIC="^PRST(455.5,",DIC(0)="AEQM",DIC("A")="Select T&L Unit: " W ! D ^DIC K DIC I "^"[X!$D(DTOUT) S TLI="" Q
G:Y<1 P1 S TLI=+Y
P2 S TLE=$P($G(^PRST(455.5,TLI,0)),"^",1) Q
QUE ; Queue a task
K IO("Q"),ZTUCI,ZTDTH,ZTIO,ZTSAVE S ZTRTN=PRSAPGM,ZTREQ="@"
S ZTSAVE("ZTREQ")="",ZTSAVE("PRSTLV")="",ZTDESC=$P(XQY0,"^",1)
F V3=1:1 S V1=$P(PRSALST,"^",V3) Q:V1="" S ZTSAVE(V1)=""
D ^%ZTLOAD D ^%ZISC U IO W !,"Request Queued",! K V1,V3,PRSAPGM,PRSALST,ZTSK Q
CONTINUE() ;ASK USER TO CONTINE
;
S ANSWER=1
S DIR("A")="Continue"
S DIR(0)="Y",DIR("B")="NO" D ^DIR
I $D(DIRUT)!(Y=0) S ANSWER=0
Q ANSWER
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRSAUTL 1148 printed Oct 16, 2024@18:25:42 Page 2
PRSAUTL ; HISC/REL-Utilities ;6/4/93 11:19
+1 ;;4.0;PAID;**21**;Sep 21, 1995
+2 SET USR=""
SET SSN=$PIECE($GET(^VA(200,DUZ,1)),"^",9)
+3 IF SSN=""
WRITE !!,*7,"Your SSN was not found in the New Person File!"
SET TLI=""
QUIT
+4 SET USR=$ORDER(^PRSPC("SSN",SSN,0))
TL ; Select T&L from among those allowed
+1 KILL DIC
IF PRSTLV>5
GOTO P1
+2 SET Z1=$SELECT(PRSTLV=2:"T",PRSTLV="3":"S",1:"*")
+3 SET TLI=$ORDER(^PRST(455.5,"A"_Z1,DUZ,0))
IF TLI<1
WRITE !!,*7,"No T&L Units have been assigned to you!"
QUIT
+4 IF $ORDER(^PRST(455.5,"A"_Z1,DUZ,TLI))<1
GOTO P2
+5 SET DIC("S")="I $D(^PRST(455.5,+Y,Z1,DUZ))"
P1 SET DIC="^PRST(455.5,"
SET DIC(0)="AEQM"
SET DIC("A")="Select T&L Unit: "
WRITE !
DO ^DIC
KILL DIC
IF "^"[X!$DATA(DTOUT)
SET TLI=""
QUIT
+1 if Y<1
GOTO P1
SET TLI=+Y
P2 SET TLE=$PIECE($GET(^PRST(455.5,TLI,0)),"^",1)
QUIT
QUE ; Queue a task
+1 KILL IO("Q"),ZTUCI,ZTDTH,ZTIO,ZTSAVE
SET ZTRTN=PRSAPGM
SET ZTREQ="@"
+2 SET ZTSAVE("ZTREQ")=""
SET ZTSAVE("PRSTLV")=""
SET ZTDESC=$PIECE(XQY0,"^",1)
+3 FOR V3=1:1
SET V1=$PIECE(PRSALST,"^",V3)
if V1=""
QUIT
SET ZTSAVE(V1)=""
+4 DO ^%ZTLOAD
DO ^%ZISC
USE IO
WRITE !,"Request Queued",!
KILL V1,V3,PRSAPGM,PRSALST,ZTSK
QUIT
CONTINUE() ;ASK USER TO CONTINE
+1 ;
+2 SET ANSWER=1
+3 SET DIR("A")="Continue"
+4 SET DIR(0)="Y"
SET DIR("B")="NO"
DO ^DIR
+5 IF $DATA(DIRUT)!(Y=0)
SET ANSWER=0
+6 QUIT ANSWER
