- QAOSPRS1 ;HISC/DAD,JCW-REVIEW SUMMARY REPORT ;11/23/92 15:45
- ;;3.0;Occurrence Screen;;09/14/1993
- S X="T",%DT="" D ^%DT X ^DD("DD") S QAOTODAY=Y,QAOSQUIT=0
- K UNDL1,UNDL2 S $P(UNDL1,"-",133)="",$P(UNDL2,"=",133)=""
- F QAOSTYPE(0)=1:1:$L(QAOSLIST) Q:QAOSQUIT S QAOSTYPE=$E(QAOSLIST,QAOSTYPE(0)) D LOOP,PAUSE:($E(IOST)="C")&('QAOSQUIT)
- Q
- LOOP ;
- S QAOSPAGE=1 D HEAD
- OCCR ;
- S X="TOTAL NUMBER OF OCCURRENCES: "_QAOTOTAL("OCCR",QAOSTYPE)
- W !!,X,!,$E(UNDL2,1,$L(X)),!
- W !," 1 - TOTAL RECORDS",?67,$J(QAOTOTAL("RECR",QAOSTYPE),3,0)
- W !," 2 - EXCEPTIONS",?67,$J(QAOTOTAL("EXCP",QAOSTYPE),3,0)
- W !," 3 - DELETIONS",?67,$J(QAOTOTAL("DELT",QAOSTYPE),3,0)
- S X="SEVERITY OF OUTCOME: "_QAOTOTAL("SEVR",QAOSTYPE)
- W !!,X,!,$E(UNDL2,1,$L(X)),!
- F QAOSSEVR=-1:0 S QAOSSEVR=$O(^TMP($J,QAOSTYPE,"SEVR",QAOSSEVR)) Q:QAOSSEVR=""!QAOSQUIT D
- . S QAOSNUM=^TMP($J,QAOSTYPE,"SEVR",QAOSSEVR)
- . S QAOSIEN=+$O(^QA(741.8,"B",QAOSSEVR,0))
- . S QAOSTEXT=$P($G(^QA(741.8,QAOSIEN,0)),"^",2)
- . W !,$J(QAOSSEVR,2)," - ",QAOSTEXT,?67,$J(QAOSNUM,3,0)
- . I $Y>(IOSL-4) D PAUSE:$E(IOST)="C",HEAD:'QAOSQUIT
- . Q
- W !!,UNDL1
- CLIN ;
- S X="CLINICAL REVIEWS: "_QAOTOTAL("CLIN",QAOSTYPE)
- W !!,X,!,$E(UNDL2,1,$L(X)),!
- F QAOSFIND=0:0 S QAOSFIND=$O(^TMP($J,QAOSTYPE,"CLIN",QAOSFIND)) Q:QAOSFIND'>0!QAOSQUIT D
- . S QAOSIEN=+$O(^QA(741.6,"B",QAOSFIND,0))
- . S QAOSTEXT=$P($G(^QA(741.6,QAOSIEN,0)),"^",2)
- . S QAOSNUM=^TMP($J,QAOSTYPE,"CLIN",QAOSFIND)
- . W !,$J(QAOSFIND,2)," - ",QAOSTEXT,?67,$J(QAOSNUM,3,0)
- . I $Y>(IOSL-6) D PAUSE:$E(IOST)="C",HEAD:'QAOSQUIT
- . Q
- Q:QAOSQUIT W !!,UNDL1
- PEER ;
- S X="PEER REVIEWS: "_QAOTOTAL("PEER",QAOSTYPE)
- W !!,X,!,$E(UNDL2,1,$L(X)) D SRVHDR
- F QAOSFIND=0:0 S QAOSFIND=$O(^TMP($J,QAOSTYPE,"PEER",QAOSFIND)) Q:QAOSFIND'>0!QAOSQUIT D
- . S QAOSIEN=+$O(^QA(741.6,"B",QAOSFIND,0))
- . S QAOSTEXT=$P($G(^QA(741.6,QAOSIEN,0)),"^",2)
- . S QAOSNUM=^TMP($J,QAOSTYPE,"PEER",QAOSFIND)
- . W !,$J(QAOSFIND,2)," - ",QAOSTEXT S TAB=67,TOT=0
- . F QA=1:1:12 S X=$P(QAOSNUM,"^",QA) W ?TAB,$J(X,3,0) S TOT=TOT+X,TAB=TAB+5
- . W ?TAB,$J(TOT,5,0)
- . I $Y>(IOSL-6) D PAUSE:$E(IOST)="C",HEAD:'QAOSQUIT
- . Q
- Q:QAOSQUIT W !!,UNDL1
- MGMT ;
- S X="MANAGEMENT REVIEWS: "_QAOTOTAL("MGMT",QAOSTYPE)
- W !!,X,!,$E(UNDL2,1,$L(X)) D SRVHDR
- F QAOSACTN=0:0 S QAOSACTN=$O(^TMP($J,QAOSTYPE,"MGMT",QAOSACTN)) Q:QAOSACTN'>0!QAOSQUIT D
- . S QAOSIEN=+$O(^QA(741.7,"B",QAOSACTN,0))
- . S QAOSTEXT=$P($G(^QA(741.7,QAOSIEN,0)),"^",3)
- . S QAOSNUM=^TMP($J,QAOSTYPE,"MGMT",QAOSACTN)
- . W !,$J(QAOSACTN,2)," - ",QAOSTEXT S TAB=67,TOT=0
- . F QA=1:1:12 S X=$P(QAOSNUM,"^",QA) W ?TAB,$J(X,3,0) S TOT=TOT+X,TAB=TAB+5
- . W ?TAB,$J(TOT,5,0)
- . I $Y>(IOSL-6) D PAUSE:$E(IOST)="C",HEAD:'QAOSQUIT
- . Q
- Q:QAOSQUIT W !!,UNDL1
- CMTE ;
- S X="COMMITTEE REVIEWS: "_QAOTOTAL("CMTE",QAOSTYPE)
- W !!,X,!,$E(UNDL2,1,$L(X)),!
- 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)
- F QAOSCONF=0:0 S QAOSCONF=$O(^TMP($J,QAOSTYPE,"CMTE",QAOSCONF)) Q:QAOSCONF'>0!QAOSQUIT D
- . S QAOSNUM=^TMP($J,QAOSTYPE,"CMTE",QAOSCONF)
- . W !,$J(QAOSCONF,2)," - ",QAOSDD(QAOSCONF),?67,$J(QAOSNUM,3,0)
- . I $Y>(IOSL-6) D PAUSE:$E(IOST)="C",HEAD:'QAOSQUIT
- . Q
- W:'QAOSQUIT !!,UNDL2
- Q
- HEAD ;
- S X="OCCURRENCE SCREEN STATISTICAL REVIEW SUMMARY: "_$S(QAOSTYPE="N":"NATIONAL",QAOSTYPE="L":"LOCAL",1:"INACTIVE")_" SCREENS"
- W:(QAOSPAGE>1)!($E(IOST)="C") @IOF
- W !?(132-$L(X)/2),X,?120,QAOTODAY
- W !?(132-$L(QAQ2HED)/2),QAQ2HED,?120,"PAGE: ",QAOSPAGE,!!,UNDL2
- S QAOSPAGE=QAOSPAGE+1
- Q
- SRVHDR ;
- W ?66,"BLIND",?73,"DOM",?80,"MEDICINE",?92,"NHCU",?97,"NON",?102,"PSYCH",?113,"SCI",?121,"UNKNOWN"
- W !?66,"REHAB",?75,"INTERMED",?85,"NEUROLOGY",?97,"COUNT",?105,"REHAB-MED",?116,"SURGERY",?127,"TOTAL"
- Q
- PAUSE ;
- K DIR S DIR(0)="E" D ^DIR S QAOSQUIT=$S(Y'>0:1,1:0)
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HQAOSPRS1 3827 printed Jan 18, 2025@03:23:02 Page 2
- QAOSPRS1 ;HISC/DAD,JCW-REVIEW SUMMARY REPORT ;11/23/92 15:45
- +1 ;;3.0;Occurrence Screen;;09/14/1993
- +2 SET X="T"
- SET %DT=""
- DO ^%DT
- XECUTE ^DD("DD")
- SET QAOTODAY=Y
- SET QAOSQUIT=0
- +3 KILL UNDL1,UNDL2
- SET $PIECE(UNDL1,"-",133)=""
- SET $PIECE(UNDL2,"=",133)=""
- +4 FOR QAOSTYPE(0)=1:1:$LENGTH(QAOSLIST)
- if QAOSQUIT
- QUIT
- SET QAOSTYPE=$EXTRACT(QAOSLIST,QAOSTYPE(0))
- DO LOOP
- if ($EXTRACT(IOST)="C")&('QAOSQUIT)
- DO PAUSE
- +5 QUIT
- LOOP ;
- +1 SET QAOSPAGE=1
- DO HEAD
- OCCR ;
- +1 SET X="TOTAL NUMBER OF OCCURRENCES: "_QAOTOTAL("OCCR",QAOSTYPE)
- +2 WRITE !!,X,!,$EXTRACT(UNDL2,1,$LENGTH(X)),!
- +3 WRITE !," 1 - TOTAL RECORDS",?67,$JUSTIFY(QAOTOTAL("RECR",QAOSTYPE),3,0)
- +4 WRITE !," 2 - EXCEPTIONS",?67,$JUSTIFY(QAOTOTAL("EXCP",QAOSTYPE),3,0)
- +5 WRITE !," 3 - DELETIONS",?67,$JUSTIFY(QAOTOTAL("DELT",QAOSTYPE),3,0)
- +6 SET X="SEVERITY OF OUTCOME: "_QAOTOTAL("SEVR",QAOSTYPE)
- +7 WRITE !!,X,!,$EXTRACT(UNDL2,1,$LENGTH(X)),!
- +8 FOR QAOSSEVR=-1:0
- SET QAOSSEVR=$ORDER(^TMP($JOB,QAOSTYPE,"SEVR",QAOSSEVR))
- if QAOSSEVR=""!QAOSQUIT
- QUIT
- Begin DoDot:1
- +9 SET QAOSNUM=^TMP($JOB,QAOSTYPE,"SEVR",QAOSSEVR)
- +10 SET QAOSIEN=+$ORDER(^QA(741.8,"B",QAOSSEVR,0))
- +11 SET QAOSTEXT=$PIECE($GET(^QA(741.8,QAOSIEN,0)),"^",2)
- +12 WRITE !,$JUSTIFY(QAOSSEVR,2)," - ",QAOSTEXT,?67,$JUSTIFY(QAOSNUM,3,0)
- +13 IF $Y>(IOSL-4)
- if $EXTRACT(IOST)="C"
- DO PAUSE
- if 'QAOSQUIT
- DO HEAD
- +14 QUIT
- End DoDot:1
- +15 WRITE !!,UNDL1
- CLIN ;
- +1 SET X="CLINICAL REVIEWS: "_QAOTOTAL("CLIN",QAOSTYPE)
- +2 WRITE !!,X,!,$EXTRACT(UNDL2,1,$LENGTH(X)),!
- +3 FOR QAOSFIND=0:0
- SET QAOSFIND=$ORDER(^TMP($JOB,QAOSTYPE,"CLIN",QAOSFIND))
- if QAOSFIND'>0!QAOSQUIT
- QUIT
- Begin DoDot:1
- +4 SET QAOSIEN=+$ORDER(^QA(741.6,"B",QAOSFIND,0))
- +5 SET QAOSTEXT=$PIECE($GET(^QA(741.6,QAOSIEN,0)),"^",2)
- +6 SET QAOSNUM=^TMP($JOB,QAOSTYPE,"CLIN",QAOSFIND)
- +7 WRITE !,$JUSTIFY(QAOSFIND,2)," - ",QAOSTEXT,?67,$JUSTIFY(QAOSNUM,3,0)
- +8 IF $Y>(IOSL-6)
- if $EXTRACT(IOST)="C"
- DO PAUSE
- if 'QAOSQUIT
- DO HEAD
- +9 QUIT
- End DoDot:1
- +10 if QAOSQUIT
- QUIT
- WRITE !!,UNDL1
- PEER ;
- +1 SET X="PEER REVIEWS: "_QAOTOTAL("PEER",QAOSTYPE)
- +2 WRITE !!,X,!,$EXTRACT(UNDL2,1,$LENGTH(X))
- DO SRVHDR
- +3 FOR QAOSFIND=0:0
- SET QAOSFIND=$ORDER(^TMP($JOB,QAOSTYPE,"PEER",QAOSFIND))
- if QAOSFIND'>0!QAOSQUIT
- QUIT
- Begin DoDot:1
- +4 SET QAOSIEN=+$ORDER(^QA(741.6,"B",QAOSFIND,0))
- +5 SET QAOSTEXT=$PIECE($GET(^QA(741.6,QAOSIEN,0)),"^",2)
- +6 SET QAOSNUM=^TMP($JOB,QAOSTYPE,"PEER",QAOSFIND)
- +7 WRITE !,$JUSTIFY(QAOSFIND,2)," - ",QAOSTEXT
- SET TAB=67
- SET TOT=0
- +8 FOR QA=1:1:12
- SET X=$PIECE(QAOSNUM,"^",QA)
- WRITE ?TAB,$JUSTIFY(X,3,0)
- SET TOT=TOT+X
- SET TAB=TAB+5
- +9 WRITE ?TAB,$JUSTIFY(TOT,5,0)
- +10 IF $Y>(IOSL-6)
- if $EXTRACT(IOST)="C"
- DO PAUSE
- if 'QAOSQUIT
- DO HEAD
- +11 QUIT
- End DoDot:1
- +12 if QAOSQUIT
- QUIT
- WRITE !!,UNDL1
- MGMT ;
- +1 SET X="MANAGEMENT REVIEWS: "_QAOTOTAL("MGMT",QAOSTYPE)
- +2 WRITE !!,X,!,$EXTRACT(UNDL2,1,$LENGTH(X))
- DO SRVHDR
- +3 FOR QAOSACTN=0:0
- SET QAOSACTN=$ORDER(^TMP($JOB,QAOSTYPE,"MGMT",QAOSACTN))
- if QAOSACTN'>0!QAOSQUIT
- QUIT
- Begin DoDot:1
- +4 SET QAOSIEN=+$ORDER(^QA(741.7,"B",QAOSACTN,0))
- +5 SET QAOSTEXT=$PIECE($GET(^QA(741.7,QAOSIEN,0)),"^",3)
- +6 SET QAOSNUM=^TMP($JOB,QAOSTYPE,"MGMT",QAOSACTN)
- +7 WRITE !,$JUSTIFY(QAOSACTN,2)," - ",QAOSTEXT
- SET TAB=67
- SET TOT=0
- +8 FOR QA=1:1:12
- SET X=$PIECE(QAOSNUM,"^",QA)
- WRITE ?TAB,$JUSTIFY(X,3,0)
- SET TOT=TOT+X
- SET TAB=TAB+5
- +9 WRITE ?TAB,$JUSTIFY(TOT,5,0)
- +10 IF $Y>(IOSL-6)
- if $EXTRACT(IOST)="C"
- DO PAUSE
- if 'QAOSQUIT
- DO HEAD
- +11 QUIT
- End DoDot:1
- +12 if QAOSQUIT
- QUIT
- WRITE !!,UNDL1
- CMTE ;
- +1 SET X="COMMITTEE REVIEWS: "_QAOTOTAL("CMTE",QAOSTYPE)
- +2 WRITE !!,X,!,$EXTRACT(UNDL2,1,$LENGTH(X)),!
- +3 SET QAOSDD=$PIECE(^DD(741.017,4,0),"^",3)
- FOR QA=1:1:$LENGTH(QAOSDD,";")-1
- SET X=$PIECE(QAOSDD,";",QA)
- SET QAOSDD($PIECE(X,":"))=$PIECE(X,":",2)
- +4 FOR QAOSCONF=0:0
- SET QAOSCONF=$ORDER(^TMP($JOB,QAOSTYPE,"CMTE",QAOSCONF))
- if QAOSCONF'>0!QAOSQUIT
- QUIT
- Begin DoDot:1
- +5 SET QAOSNUM=^TMP($JOB,QAOSTYPE,"CMTE",QAOSCONF)
- +6 WRITE !,$JUSTIFY(QAOSCONF,2)," - ",QAOSDD(QAOSCONF),?67,$JUSTIFY(QAOSNUM,3,0)
- +7 IF $Y>(IOSL-6)
- if $EXTRACT(IOST)="C"
- DO PAUSE
- if 'QAOSQUIT
- DO HEAD
- +8 QUIT
- End DoDot:1
- +9 if 'QAOSQUIT
- WRITE !!,UNDL2
- +10 QUIT
- HEAD ;
- +1 SET X="OCCURRENCE SCREEN STATISTICAL REVIEW SUMMARY: "_$SELECT(QAOSTYPE="N":"NATIONAL",QAOSTYPE="L":"LOCAL",1:"INACTIVE")_" SCREENS"
- +2 if (QAOSPAGE>1)!($EXTRACT(IOST)="C")
- WRITE @IOF
- +3 WRITE !?(132-$LENGTH(X)/2),X,?120,QAOTODAY
- +4 WRITE !?(132-$LENGTH(QAQ2HED)/2),QAQ2HED,?120,"PAGE: ",QAOSPAGE,!!,UNDL2
- +5 SET QAOSPAGE=QAOSPAGE+1
- +6 QUIT
- SRVHDR ;
- +1 WRITE ?66,"BLIND",?73,"DOM",?80,"MEDICINE",?92,"NHCU",?97,"NON",?102,"PSYCH",?113,"SCI",?121,"UNKNOWN"
- +2 WRITE !?66,"REHAB",?75,"INTERMED",?85,"NEUROLOGY",?97,"COUNT",?105,"REHAB-MED",?116,"SURGERY",?127,"TOTAL"
- +3 QUIT
- PAUSE ;
- +1 KILL DIR
- SET DIR(0)="E"
- DO ^DIR
- SET QAOSQUIT=$SELECT(Y'>0:1,1:0)
- +2 QUIT