Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: QAOSPRS1

QAOSPRS1.m

Go to the documentation of this file.
  1. QAOSPRS1 ;HISC/DAD,JCW-REVIEW SUMMARY REPORT ;11/23/92 15:45
  1. ;;3.0;Occurrence Screen;;09/14/1993
  1. S X="T",%DT="" D ^%DT X ^DD("DD") S QAOTODAY=Y,QAOSQUIT=0
  1. K UNDL1,UNDL2 S $P(UNDL1,"-",133)="",$P(UNDL2,"=",133)=""
  1. F QAOSTYPE(0)=1:1:$L(QAOSLIST) Q:QAOSQUIT S QAOSTYPE=$E(QAOSLIST,QAOSTYPE(0)) D LOOP,PAUSE:($E(IOST)="C")&('QAOSQUIT)
  1. Q
  1. LOOP ;
  1. S QAOSPAGE=1 D HEAD
  1. OCCR ;
  1. S X="TOTAL NUMBER OF OCCURRENCES: "_QAOTOTAL("OCCR",QAOSTYPE)
  1. W !!,X,!,$E(UNDL2,1,$L(X)),!
  1. W !," 1 - TOTAL RECORDS",?67,$J(QAOTOTAL("RECR",QAOSTYPE),3,0)
  1. W !," 2 - EXCEPTIONS",?67,$J(QAOTOTAL("EXCP",QAOSTYPE),3,0)
  1. W !," 3 - DELETIONS",?67,$J(QAOTOTAL("DELT",QAOSTYPE),3,0)
  1. S X="SEVERITY OF OUTCOME: "_QAOTOTAL("SEVR",QAOSTYPE)
  1. W !!,X,!,$E(UNDL2,1,$L(X)),!
  1. F QAOSSEVR=-1:0 S QAOSSEVR=$O(^TMP($J,QAOSTYPE,"SEVR",QAOSSEVR)) Q:QAOSSEVR=""!QAOSQUIT D
  1. . S QAOSNUM=^TMP($J,QAOSTYPE,"SEVR",QAOSSEVR)
  1. . S QAOSIEN=+$O(^QA(741.8,"B",QAOSSEVR,0))
  1. . S QAOSTEXT=$P($G(^QA(741.8,QAOSIEN,0)),"^",2)
  1. . W !,$J(QAOSSEVR,2)," - ",QAOSTEXT,?67,$J(QAOSNUM,3,0)
  1. . I $Y>(IOSL-4) D PAUSE:$E(IOST)="C",HEAD:'QAOSQUIT
  1. . Q
  1. W !!,UNDL1
  1. CLIN ;
  1. S X="CLINICAL REVIEWS: "_QAOTOTAL("CLIN",QAOSTYPE)
  1. W !!,X,!,$E(UNDL2,1,$L(X)),!
  1. F QAOSFIND=0:0 S QAOSFIND=$O(^TMP($J,QAOSTYPE,"CLIN",QAOSFIND)) Q:QAOSFIND'>0!QAOSQUIT D
  1. . S QAOSIEN=+$O(^QA(741.6,"B",QAOSFIND,0))
  1. . S QAOSTEXT=$P($G(^QA(741.6,QAOSIEN,0)),"^",2)
  1. . S QAOSNUM=^TMP($J,QAOSTYPE,"CLIN",QAOSFIND)
  1. . W !,$J(QAOSFIND,2)," - ",QAOSTEXT,?67,$J(QAOSNUM,3,0)
  1. . I $Y>(IOSL-6) D PAUSE:$E(IOST)="C",HEAD:'QAOSQUIT
  1. . Q
  1. Q:QAOSQUIT W !!,UNDL1
  1. PEER ;
  1. S X="PEER REVIEWS: "_QAOTOTAL("PEER",QAOSTYPE)
  1. W !!,X,!,$E(UNDL2,1,$L(X)) D SRVHDR
  1. F QAOSFIND=0:0 S QAOSFIND=$O(^TMP($J,QAOSTYPE,"PEER",QAOSFIND)) Q:QAOSFIND'>0!QAOSQUIT D
  1. . S QAOSIEN=+$O(^QA(741.6,"B",QAOSFIND,0))
  1. . S QAOSTEXT=$P($G(^QA(741.6,QAOSIEN,0)),"^",2)
  1. . S QAOSNUM=^TMP($J,QAOSTYPE,"PEER",QAOSFIND)
  1. . W !,$J(QAOSFIND,2)," - ",QAOSTEXT S TAB=67,TOT=0
  1. . F QA=1:1:12 S X=$P(QAOSNUM,"^",QA) W ?TAB,$J(X,3,0) S TOT=TOT+X,TAB=TAB+5
  1. . W ?TAB,$J(TOT,5,0)
  1. . I $Y>(IOSL-6) D PAUSE:$E(IOST)="C",HEAD:'QAOSQUIT
  1. . Q
  1. Q:QAOSQUIT W !!,UNDL1
  1. MGMT ;
  1. S X="MANAGEMENT REVIEWS: "_QAOTOTAL("MGMT",QAOSTYPE)
  1. W !!,X,!,$E(UNDL2,1,$L(X)) D SRVHDR
  1. F QAOSACTN=0:0 S QAOSACTN=$O(^TMP($J,QAOSTYPE,"MGMT",QAOSACTN)) Q:QAOSACTN'>0!QAOSQUIT D
  1. . S QAOSIEN=+$O(^QA(741.7,"B",QAOSACTN,0))
  1. . S QAOSTEXT=$P($G(^QA(741.7,QAOSIEN,0)),"^",3)
  1. . S QAOSNUM=^TMP($J,QAOSTYPE,"MGMT",QAOSACTN)
  1. . W !,$J(QAOSACTN,2)," - ",QAOSTEXT S TAB=67,TOT=0
  1. . F QA=1:1:12 S X=$P(QAOSNUM,"^",QA) W ?TAB,$J(X,3,0) S TOT=TOT+X,TAB=TAB+5
  1. . W ?TAB,$J(TOT,5,0)
  1. . I $Y>(IOSL-6) D PAUSE:$E(IOST)="C",HEAD:'QAOSQUIT
  1. . Q
  1. Q:QAOSQUIT W !!,UNDL1
  1. CMTE ;
  1. S X="COMMITTEE REVIEWS: "_QAOTOTAL("CMTE",QAOSTYPE)
  1. W !!,X,!,$E(UNDL2,1,$L(X)),!
  1. S QAOSDD=$P(^DD(741.017,4,0),"^",3) F QA=1:1:$L(QAOSDD,";")-1 S X=$P(QAOSDD,";",QA),QAOSDD($P(X,":"))=$P(X,":",2)
  1. F QAOSCONF=0:0 S QAOSCONF=$O(^TMP($J,QAOSTYPE,"CMTE",QAOSCONF)) Q:QAOSCONF'>0!QAOSQUIT D
  1. . S QAOSNUM=^TMP($J,QAOSTYPE,"CMTE",QAOSCONF)
  1. . W !,$J(QAOSCONF,2)," - ",QAOSDD(QAOSCONF),?67,$J(QAOSNUM,3,0)
  1. . I $Y>(IOSL-6) D PAUSE:$E(IOST)="C",HEAD:'QAOSQUIT
  1. . Q
  1. W:'QAOSQUIT !!,UNDL2
  1. Q
  1. S X="OCCURRENCE SCREEN STATISTICAL REVIEW SUMMARY: "_$S(QAOSTYPE="N":"NATIONAL",QAOSTYPE="L":"LOCAL",1:"INACTIVE")_" SCREENS"
  1. W:(QAOSPAGE>1)!($E(IOST)="C") @IOF
  1. W !?(132-$L(X)/2),X,?120,QAOTODAY
  1. W !?(132-$L(QAQ2HED)/2),QAQ2HED,?120,"PAGE: ",QAOSPAGE,!!,UNDL2
  1. S QAOSPAGE=QAOSPAGE+1
  1. Q
  1. SRVHDR ;
  1. W ?66,"BLIND",?73,"DOM",?80,"MEDICINE",?92,"NHCU",?97,"NON",?102,"PSYCH",?113,"SCI",?121,"UNKNOWN"
  1. W !?66,"REHAB",?75,"INTERMED",?85,"NEUROLOGY",?97,"COUNT",?105,"REHAB-MED",?116,"SURGERY",?127,"TOTAL"
  1. Q
  1. PAUSE ;
  1. K DIR S DIR(0)="E" D ^DIR S QAOSQUIT=$S(Y'>0:1,1:0)
  1. Q