AQAQMIS ;IHS/ASU/RPL 4/17/89;MISSING STAFF CREDENTIAL REPORT ; 11/7/89 10:00 AM
;;STAFF CREDENTIALS Version 1.1;11/7/89
START ;
S AQAQSITE=$P(^DIC(4,DUZ(2),0),"^",1)
ZIS W !! S %IS="Q" D ^%ZIS G:POP QUIT I '$D(IO("Q")) U IO G DQUE
QUE K IO("Q"),IO("S") I IO=IO(0) W !,"Cannot Queue to Screen or Slave Printer!",! G ZIS
S ZTRTN="DQUE^AQAQMIS",ZTDESC="MISSING STAFF CREDENTIALS REPORT" S ZTSAVE("AQAQSITE")=""
D ^%ZTLOAD G QUIT
DQUE K ^UTILITY($J)
S AQAQSET=^DD(9002155,1,0),AQAQSET=$P(AQAQSET,"^",3),AQAQCTR=$L(AQAQSET,":")-1
F I=1:1:AQAQCTR S AQAQS=$P(AQAQSET,";",I) S AQAQ1=$P(AQAQS,":"),AQAQ2=$P(AQAQS,":",2) S AQAQS(AQAQ1)=AQAQ2
S AQAQDFN=0 F I=0:0 S AQAQDFN=$O(^AQAQ(AQAQDFN)) Q:AQAQDFN'=+AQAQDFN D C0
G PRINT
C0 S AQAQNM=$P(^DIC(16,AQAQDFN,0),"^")
S AQAQN0=^AQAQ(AQAQDFN,0)
S AQAQSC=$P(AQAQN0,"^",2) S AQAQSC=$S(AQAQSC]"":AQAQS(AQAQSC),1:"<No Staff Category on File>")
S AQAQCADT=$P(AQAQN0,"^",3) S Y=AQAQCADT X ^DD("DD") S AQAQCADT=Y
S AQAQDEA=$P(AQAQN0,"^",12),AQAQDEA=$S(AQAQDEA="N":1,AQAQDEA="":1,1:0)
S AQAQINT=$P(AQAQN0,"^",5),AQAQINT=$S(AQAQINT="N":1,AQAQINT="":1,1:0)
S AQAQRES=$P(AQAQN0,"^",4),AQAQRES=$S(AQAQRES="N":1,AQAQRES="":1,1:0)
S AQAQPDG=$P(AQAQN0,"^",6),AQAQPDG=$S(AQAQPDG="N":1,AQAQPDG="":1,1:0)
S AQAQPDV=$P(AQAQN0,"^",14),AQAQPDV=$S(AQAQPDV="N":1,AQAQPDV="":1,1:0)
S AQAQBYL=$P(AQAQN0,"^",9),AQAQBYL=$S(AQAQBYL="N":1,AQAQBYL="":1,1:0)
S AQAQIRL=$P(AQAQN0,"^",10),AQAQIRL=$S(AQAQIRL="N":1,AQAQIRL="":1,1:0)
S AQAQCV=$P(AQAQN0,"^",11),AQAQCV=$S(AQAQCV="N":1,AQAQCV="":1,1:0)
S AQAQ3LR=$P(AQAQN0,"^",13),AQAQ3LR=$S(AQAQ3LR="N":1,AQAQ3LR="":1,1:0)
K AQAQMLF I $P(AQAQN0,"^",2)="AF" S (AQAQMLF,AQAQMLV)=0 G C01
I '$D(^AQAQ(AQAQDFN,3)) S (AQAQMLF,AQAQMLV)=1 G C01
S AQAQ3=0 F J=0:0 S AQAQ3=$O(^AQAQ(AQAQDFN,3,AQAQ3)) Q:'AQAQ3 S AQAQMLF=0 S AQAQMLV=$P(^(AQAQ3,0),"^",2),AQAQMLV=$S(AQAQMLV="N":1,AQAQMLV="":1,1:0)
S:'$D(AQAQMLF) (AQAQMLV,AQAQMLF)=1
C01 I '$D(^AQAQ(AQAQDFN,2)) S AQAQHSS=1 G C02
S AQAQHSS=$P(^AQAQ(AQAQDFN,2),"^"),AQAQHSS=$S(AQAQHSS="N":1,AQAQHSS="":1,1:0)
C02 K AQAQHSV I '$D(^AQAQ(AQAQDFN,6)) S AQAQHSV=1 G C03
S AQAQ6=0 F J=0:0 S AQAQ6=$O(^AQAQ(AQAQDFN,6,AQAQ6)) Q:'AQAQ6 S AQAQHSV=0 Q
I '$D(AQAQHSV) S AQAQHSV=1
C03 K AQAQCAD I '$D(^AQAQ(AQAQDFN,9)) S AQAQCAD=1 G C04
S AQAQ9=0 F J=0:0 S AQAQ9=$O(^AQAQ(AQAQDFN,9,AQAQ9)) Q:'AQAQ9 S AQAQCAD=0 Q
I '$D(AQAQCAD) S AQAQCAD=1
C04 K AQAQCPR,AQAQCPA I '$D(^AQAQ(AQAQDFN,10)) S (AQAQCPR,AQAQCPA)=1 G C05
S AQAQ10=0 F J=0:0 S AQAQ10=$O(^AQAQ(AQAQDFN,10,AQAQ10)) Q:'AQAQ10 S AQAQCPR=0 S AQAQCPA=$P(^(AQAQ10,0),"^",2),AQAQCPA=$S(AQAQCPA="":1,1:0)
C05 S ^UTILITY($J,AQAQNM,AQAQDFN)=AQAQSC_"^"_AQAQCADT_"^"_AQAQDEA_"^"_AQAQINT_"^"_AQAQRES_"^"_AQAQPDG_"^"_AQAQPDV_"^"_AQAQBYL_"^"_AQAQIRL_"^"_AQAQCV_"^"_AQAQ3LR_"^"_AQAQMLF_"^"_AQAQMLV_"^"_AQAQHSS_"^"_AQAQHSV_"^"_AQAQCAD_"^"_AQAQCPR_"^"_AQAQCPA
Q
;
PRINT D ^AQAQMIS1
QUIT2 I $D(ZTSK) K ^%ZTSK(ZTSK)
QUIT I $D(IOST),'$D(AQAQQUIT),$D(IO),$E(IOST)="C",IO=IO(0) R X:DTIME
W @IOF
X ^%ZIS("C") K Y,DIC,%DT,^UTILITY($J),ZTSK,IO("Q"),IO("S"),II,I,J,K,JJ,L,M,X
K AQAQ,AQAQQUIT,AQAQ1,AQAQ10,AQAQ2,AQAQ3,AQAQ3LR,AQAQ6,AQAQ80D,AQAQ9,AQAQBYL,AQAQCAD,AQAQCADT,AQAQCPA,AQAQCPR,AQAQCPS,AQAQCTR,AQAQCV,AQAQDEA,AQAQDFN,AQAQDTP,AQAQHSS
K AQAQHSV,AQAQINT,AQAQIRL,AQAQMLF,AQAQMLV,AQAQN0,AQAQNM,AQAQPDG,AQAQPDV,AQAQPG,AQAQRES,AQAQS,AQAQSC,AQAQSET,AQAQSITE
Q
AQAQMIS ;IHS/ASU/RPL 4/17/89;MISSING STAFF CREDENTIAL REPORT ; 11/7/89 10:00 AM
+1 ;;STAFF CREDENTIALS Version 1.1;11/7/89
START ;
+1 SET AQAQSITE=$PIECE(^DIC(4,DUZ(2),0),"^",1)
ZIS WRITE !!
SET %IS="Q"
DO ^%ZIS
IF POP
GOTO QUIT
IF '$DATA(IO("Q"))
USE IO
GOTO DQUE
QUE KILL IO("Q"),IO("S")
IF IO=IO(0)
WRITE !,"Cannot Queue to Screen or Slave Printer!",!
GOTO ZIS
+1 SET ZTRTN="DQUE^AQAQMIS"
SET ZTDESC="MISSING STAFF CREDENTIALS REPORT"
SET ZTSAVE("AQAQSITE")=""
+2 DO ^%ZTLOAD
GOTO QUIT
DQUE KILL ^UTILITY($JOB)
+1 SET AQAQSET=^DD(9002155,1,0)
SET AQAQSET=$PIECE(AQAQSET,"^",3)
SET AQAQCTR=$LENGTH(AQAQSET,":")-1
+2 FOR I=1:1:AQAQCTR
SET AQAQS=$PIECE(AQAQSET,";",I)
SET AQAQ1=$PIECE(AQAQS,":")
SET AQAQ2=$PIECE(AQAQS,":",2)
SET AQAQS(AQAQ1)=AQAQ2
+3 SET AQAQDFN=0
FOR I=0:0
SET AQAQDFN=$ORDER(^AQAQ(AQAQDFN))
IF AQAQDFN'=+AQAQDFN
QUIT
DO C0
+4 GOTO PRINT
C0 SET AQAQNM=$PIECE(^DIC(16,AQAQDFN,0),"^")
+1 SET AQAQN0=^AQAQ(AQAQDFN,0)
+2 SET AQAQSC=$PIECE(AQAQN0,"^",2)
SET AQAQSC=$SELECT(AQAQSC]"":AQAQS(AQAQSC),1:"<No Staff Category on File>")
+3 SET AQAQCADT=$PIECE(AQAQN0,"^",3)
SET Y=AQAQCADT
XECUTE ^DD("DD")
SET AQAQCADT=Y
+4 SET AQAQDEA=$PIECE(AQAQN0,"^",12)
SET AQAQDEA=$SELECT(AQAQDEA="N":1,AQAQDEA="":1,1:0)
+5 SET AQAQINT=$PIECE(AQAQN0,"^",5)
SET AQAQINT=$SELECT(AQAQINT="N":1,AQAQINT="":1,1:0)
+6 SET AQAQRES=$PIECE(AQAQN0,"^",4)
SET AQAQRES=$SELECT(AQAQRES="N":1,AQAQRES="":1,1:0)
+7 SET AQAQPDG=$PIECE(AQAQN0,"^",6)
SET AQAQPDG=$SELECT(AQAQPDG="N":1,AQAQPDG="":1,1:0)
+8 SET AQAQPDV=$PIECE(AQAQN0,"^",14)
SET AQAQPDV=$SELECT(AQAQPDV="N":1,AQAQPDV="":1,1:0)
+9 SET AQAQBYL=$PIECE(AQAQN0,"^",9)
SET AQAQBYL=$SELECT(AQAQBYL="N":1,AQAQBYL="":1,1:0)
+10 SET AQAQIRL=$PIECE(AQAQN0,"^",10)
SET AQAQIRL=$SELECT(AQAQIRL="N":1,AQAQIRL="":1,1:0)
+11 SET AQAQCV=$PIECE(AQAQN0,"^",11)
SET AQAQCV=$SELECT(AQAQCV="N":1,AQAQCV="":1,1:0)
+12 SET AQAQ3LR=$PIECE(AQAQN0,"^",13)
SET AQAQ3LR=$SELECT(AQAQ3LR="N":1,AQAQ3LR="":1,1:0)
+13 KILL AQAQMLF
IF $PIECE(AQAQN0,"^",2)="AF"
SET (AQAQMLF,AQAQMLV)=0
GOTO C01
+14 IF '$DATA(^AQAQ(AQAQDFN,3))
SET (AQAQMLF,AQAQMLV)=1
GOTO C01
+15 SET AQAQ3=0
FOR J=0:0
SET AQAQ3=$ORDER(^AQAQ(AQAQDFN,3,AQAQ3))
IF 'AQAQ3
QUIT
SET AQAQMLF=0
SET AQAQMLV=$PIECE(^(AQAQ3,0),"^",2)
SET AQAQMLV=$SELECT(AQAQMLV="N":1,AQAQMLV="":1,1:0)
+16 IF '$DATA(AQAQMLF)
SET (AQAQMLV,AQAQMLF)=1
C01 IF '$DATA(^AQAQ(AQAQDFN,2))
SET AQAQHSS=1
GOTO C02
+1 SET AQAQHSS=$PIECE(^AQAQ(AQAQDFN,2),"^")
SET AQAQHSS=$SELECT(AQAQHSS="N":1,AQAQHSS="":1,1:0)
C02 KILL AQAQHSV
IF '$DATA(^AQAQ(AQAQDFN,6))
SET AQAQHSV=1
GOTO C03
+1 SET AQAQ6=0
FOR J=0:0
SET AQAQ6=$ORDER(^AQAQ(AQAQDFN,6,AQAQ6))
IF 'AQAQ6
QUIT
SET AQAQHSV=0
QUIT
+2 IF '$DATA(AQAQHSV)
SET AQAQHSV=1
C03 KILL AQAQCAD
IF '$DATA(^AQAQ(AQAQDFN,9))
SET AQAQCAD=1
GOTO C04
+1 SET AQAQ9=0
FOR J=0:0
SET AQAQ9=$ORDER(^AQAQ(AQAQDFN,9,AQAQ9))
IF 'AQAQ9
QUIT
SET AQAQCAD=0
QUIT
+2 IF '$DATA(AQAQCAD)
SET AQAQCAD=1
C04 KILL AQAQCPR,AQAQCPA
IF '$DATA(^AQAQ(AQAQDFN,10))
SET (AQAQCPR,AQAQCPA)=1
GOTO C05
+1 SET AQAQ10=0
FOR J=0:0
SET AQAQ10=$ORDER(^AQAQ(AQAQDFN,10,AQAQ10))
IF 'AQAQ10
QUIT
SET AQAQCPR=0
SET AQAQCPA=$PIECE(^(AQAQ10,0),"^",2)
SET AQAQCPA=$SELECT(AQAQCPA="":1,1:0)
C05 SET ^UTILITY($JOB,AQAQNM,AQAQDFN)=AQAQSC_"^"_AQAQCADT_"^"_AQAQDEA_"^"_AQAQINT_"^"_AQAQRES_"^"_AQAQPDG_"^"_AQAQPDV_"^"_AQAQBYL_"^"_AQAQIRL_"^"_AQAQCV_"^"_AQAQ3LR_"^"_AQAQMLF_"^"_AQAQMLV_"^"_AQAQHSS_"^"_AQAQHSV_"^"_AQAQCAD_"^"_AQAQCPR_"^"_AQAQCPA
+1 QUIT
+2 ;
PRINT DO ^AQAQMIS1
QUIT2 IF $DATA(ZTSK)
KILL ^%ZTSK(ZTSK)
QUIT IF $DATA(IOST)
IF '$DATA(AQAQQUIT)
IF $DATA(IO)
IF $EXTRACT(IOST)="C"
IF IO=IO(0)
READ X:DTIME
+1 WRITE @IOF
+2 XECUTE ^%ZIS("C")
KILL Y,DIC,%DT,^UTILITY($JOB),ZTSK,IO("Q"),IO("S"),II,I,J,K,JJ,L,M,X
+3 KILL AQAQ,AQAQQUIT,AQAQ1,AQAQ10,AQAQ2,AQAQ3,AQAQ3LR,AQAQ6,AQAQ80D,AQAQ9,AQAQBYL,AQAQCAD,AQAQCADT,AQAQCPA,AQAQCPR,AQAQCPS,AQAQCTR,AQAQCV,AQAQDEA,AQAQDFN,AQAQDTP,AQAQHSS
+4 KILL AQAQHSV,AQAQINT,AQAQIRL,AQAQMLF,AQAQMLV,AQAQN0,AQAQNM,AQAQPDG,AQAQPDV,AQAQPG,AQAQRES,AQAQS,AQAQSC,AQAQSET,AQAQSITE
+5 QUIT
