- 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 Feb 18, 2025@23:47:46 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
