source: WorldVistAEHR/trunk/r/OCCURRENCE_SCREEN-QAO/QAOSPRS2.m@ 1000

Last change on this file since 1000 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.3 KB
RevLine 
[613]1QAOSPRS2 ;HISC/DAD,JCW-REVIEW SUMMARY REPORT ;11/12/92 15:43
2 ;;3.0;Occurrence Screen;;09/14/1993
3SETUP ; INITIALIZE ARRAYS
4 D KILLTMP
5 S QAOSCLIN=$O(^QA(741.2,"C",1,0)),QAOSPEER=$O(^QA(741.2,"C",2,0)),QAOSMGMT=$O(^QA(741.2,"C",3,0)),QAOSRV=$P(^DD(42,.03,0),"^",3)_"^:UNKNOWN;"
6 F QAOSREVR="OCCR","EXCP","DELT","RECR","SEVR","CLIN","PEER","MGMT","CMTE" F QAOSTYPE=1:1:$L(QAOSLIST) S QAOTOTAL(QAOSREVR,$E(QAOSLIST,QAOSTYPE))=0
7 F QAOSD0=0:0 S QAOSD0=$O(^QA(741.6,QAOSD0)) Q:QAOSD0'>0 S QAOSZERO=^QA(741.6,QAOSD0,0) I +QAOSZERO'=3 F QAOSTYPE=1:1:$L(QAOSLIST) D
8 . S QAOSTYPE(0)=$E(QAOSLIST,QAOSTYPE),X=$P(QAOSZERO,"^",3)
9 . I X["1" S ^TMP($J,QAOSTYPE(0),"CLIN",+QAOSZERO)=""
10 . I X["2" S ^TMP($J,QAOSTYPE(0),"PEER",+QAOSZERO)=""
11 . Q
12 F QAOSD0=0:0 S QAOSD0=$O(^QA(741.7,QAOSD0)) Q:QAOSD0'>0 S QAOSZERO=^QA(741.7,QAOSD0,0) I $P(QAOSZERO,"^",2)["3" F QAOSTYPE=1:1:$L(QAOSLIST) S QAOSTYPE(0)=$E(QAOSLIST,QAOSTYPE),^TMP($J,QAOSTYPE(0),"MGMT",+QAOSZERO)=""
13 F QAOSD0=0:0 S QAOSD0=$O(^QA(741.8,QAOSD0)) Q:QAOSD0'>0 S QAOSEVER=+^QA(741.8,QAOSD0,0) F QAOSTYPE=1:1:$L(QAOSLIST) S QAOSTYPE(0)=$E(QAOSLIST,QAOSTYPE),^TMP($J,QAOSTYPE(0),"SEVR",QAOSEVER)=""
14 F QAOSCONF=1:1:4 F QAOSTYPE=1:1:$L(QAOSLIST) S QAOSTYPE(0)=$E(QAOSLIST,QAOSTYPE),^TMP($J,QAOSTYPE(0),"CMTE",QAOSCONF)=""
15 Q
16KILLTMP ; CLEANUP ^TMP
17 N I,J
18 F I="1","L","N" F J="CLIN","PEER","MGMT","SEVR","CMTE" K ^TMP($J,I,J)
19 Q
Note: See TracBrowser for help on using the repository browser.