- 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 Jan 18, 2025@03:26:08 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