QAOSCNV4 ;HISC/DAD-AUTO ALLOCATE QAOSCLIN KEY FROM CLIN REVR FILE (#741.3) ;11/24/92 13:30
;;3.0;Occurrence Screen;;09/14/1993
W !!,"Allocating the QAOSCLIN security key to the persons in the"
W !,"QA OCCURRENCE SCREEN CLINICAL REVIEWER file (#741.3)"
W !,"----------------------------------------------------------"
K ^TMP($J,"QAOSCLIN ADD"),^TMP($J,"QAOSCLIN DEL")
F QAOSDUZ=0:0 S QAOSDUZ=$O(^QA(741.3,"B",QAOSDUZ)) Q:QAOSDUZ'>0 D
. S QAOSDUZ(0)=$P($G(^VA(200,QAOSDUZ,0)),"^")
. Q:QAOSDUZ(0)=""
. S ^TMP($J,"QAOSCLIN ADD",QAOSDUZ(0),QAOSDUZ)=""
. Q
S QAOSCLIN(0)="QAOSCLIN",QAOSCLIN=+$O(^DIC(19.1,"B",QAOSCLIN(0),0))
D DOIT^QAOSCKEY
K QAOSDUZ,^TMP($J,"QAOSCLIN ADD")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HQAOSCNV4 702 printed Dec 13, 2024@02:21:19 Page 2
QAOSCNV4 ;HISC/DAD-AUTO ALLOCATE QAOSCLIN KEY FROM CLIN REVR FILE (#741.3) ;11/24/92 13:30
+1 ;;3.0;Occurrence Screen;;09/14/1993
+2 WRITE !!,"Allocating the QAOSCLIN security key to the persons in the"
+3 WRITE !,"QA OCCURRENCE SCREEN CLINICAL REVIEWER file (#741.3)"
+4 WRITE !,"----------------------------------------------------------"
+5 KILL ^TMP($JOB,"QAOSCLIN ADD"),^TMP($JOB,"QAOSCLIN DEL")
+6 FOR QAOSDUZ=0:0
SET QAOSDUZ=$ORDER(^QA(741.3,"B",QAOSDUZ))
if QAOSDUZ'>0
QUIT
Begin DoDot:1
+7 SET QAOSDUZ(0)=$PIECE($GET(^VA(200,QAOSDUZ,0)),"^")
+8 if QAOSDUZ(0)=""
QUIT
+9 SET ^TMP($JOB,"QAOSCLIN ADD",QAOSDUZ(0),QAOSDUZ)=""
+10 QUIT
End DoDot:1
+11 SET QAOSCLIN(0)="QAOSCLIN"
SET QAOSCLIN=+$ORDER(^DIC(19.1,"B",QAOSCLIN(0),0))
+12 DO DOIT^QAOSCKEY
+13 KILL QAOSDUZ,^TMP($JOB,"QAOSCLIN ADD")
+14 QUIT
