- QAOSUPL2 ;HISC/DAD-GENERATE SUMMARY OF OS UPLOAD BULLETIN ;10/7/93 11:01
- ;;3.0;Occurrence Screen;**3**;09/14/1993
- EN ;
- D KILL^XM
- S XMSUB="SUMMARY OF OCCURRENCE SCREEN"
- S XMDUZ=QAOSSITE,XMTEXT="QAOSUPLD("
- S XMY(QAOSSERV_"@"_QAOSDOM)=""
- ASKMAIL ;
- W @IOF
- W !,"Reporting period: ",QAQ2HED
- W !!,"Results of Reliability Assessments."
- W !?5,"Date clinical review reliability assessment completed:"
- S Y=QAOSRELY("C",1) X ^DD("DD") W ?69,$S(Y]"":Y,1:"N/A")
- W !?5,"Percentage agreement found:"
- S Y=QAOSRELY("C",2) W ?69,$S(Y]"":$J(Y,6,2)_"%",1:"N/A")
- W !?5,"Date peer review reliability assessment completed: "
- S Y=QAOSRELY("P",1) X ^DD("DD") W ?69,$S(Y]"":Y,1:"N/A")
- W !?5,"Percentage agreement found:"
- S Y=QAOSRELY("P",2) W ?69,$S(Y]"":$J(Y,6,2)_"%",1:"N/A")
- W !!,"Facility Workload Data."
- W !?5,"Number of admissions to acute care by bed section."
- W !?10,"Medicine (Include Neurology, exclude Intermediate Med.):"
- S Y=QAOSWORK(1) W ?66,$S(Y]"":$J(Y,6),1:" N/A")
- W !?10,"Surgery:" S Y=QAOSWORK(2) W ?66,$S(Y]"":$J(Y,6),1:" N/A")
- W !?10,"Psychiatry:" S Y=QAOSWORK(3) W ?66,$S(Y]"":$J(Y,6),1:" N/A")
- W !?5,"Number of ""Unscheduled"" and ""10-10"" ambulatory care visits:"
- S Y=QAOSWORK(4) W ?66,$S(Y]"":$J(Y,6),1:" N/A")
- W !?5,"Number of surgical procedures performed:"
- S Y=QAOSWORK(7) W ?66,$S(Y]"":$J(Y,6),1:" N/A")
- ;
- W !!,"WARNING: This data will overwrite your pre-existing data"
- W !," at the NQADB for this semi-annual period !!"
- W !!,"Ready to send the ",XMSUB," data to the National Quality"
- W !,"Assurance DataBase (NQADB) at ",QAOSSERV,"@",QAOSDOM
- W !,"OK to send" S %=2 D YN^DICN G:(%=-1)!(%=2) EXIT
- I '% W !!?5,"Please answer Y(es) or N(o) " R QA:5 G ASKMAIL
- W !,"Sending . . ." D BUILD,^XMD
- EXIT ;
- K %,ERROR,QA,QAOERROR,QAOSDATA,QAOSDOM,QAOSLIST,QAOSSCRN,QAOSSEQ
- K QAOSSERV,QAOSSITE,QAOSSTNO,QAOSUPLD,QAOSZERO,QAO,QAOS,QAOSCLIN,QAOSCRN
- K QAOSD0,QAOSDATE,QAOSFIND,QAOSLINE,QAOSMGMT,QAOSNUM,QAOSPEER,QAOSRELY
- K QAOSRFPR,QAOSSPEC,QAOSWORK,QAOFINAL,QAOSACTN,QAOSCREV,QAOSD1,QAOSHOSP
- K QAOSLEVL,QAOSRV,QAOSS1,QAOSS2,QAOSSTAT,QAOSTEMP,QAOSWARD,SERV
- K ^UTILITY($J,"QAOSPSM"),^UTILITY($J,"QAOSXREF"),^UTILITY($J,"QAOSPEND")
- D K^QAQDATE,KILL^XM S:$D(ZTQUEUED) ZTREQ="@"
- Q
- BUILD ;
- S QAOSLIST(0)="1," D ^QAOSPSM0
- K QAOSUPLD S QAOSLINE=1
- SERVER ;
- S QAOSUPLD(QAOSLINE)="^^QAO0^",QAOSLINE=QAOSLINE+1
- SITE ;
- S QAOSUPLD(QAOSLINE)="SITE",QAOSLINE=QAOSLINE+1
- S QAOSUPLD(QAOSLINE)=QAOSSTNO_"^"_QAOSSITE_"^"_QAQNBEG_"^"_QAQNEND_"^"
- S QAOSLINE=QAOSLINE+1
- RELY ;
- S QAOSUPLD(QAOSLINE)="RELY",QAOSLINE=QAOSLINE+1
- S X=QAOSRELY("C",1)_"^"_QAOSRELY("C",2)_"^"
- S X=X_QAOSRELY("P",1)_"^"_QAOSRELY("P",2)_"^"
- S QAOSUPLD(QAOSLINE)=X,QAOSLINE=QAOSLINE+1
- WORK ;
- S QAOSUPLD(QAOSLINE)="WORK",QAOSLINE=QAOSLINE+1,X=""
- F QA=1:1:7 S X=X_QAOSWORK(QA)_"^"
- S QAOSUPLD(QAOSLINE)=X,QAOSLINE=QAOSLINE+1
- ACTN ;
- S QAOSUPLD(QAOSLINE)="ACTN",QAOSLINE=QAOSLINE+1,X=""
- F QA=8:1:22 S X=X_QA_";"_+$G(QAOSACTN("N",QA))_"^"
- S QAOSUPLD(QAOSLINE)=X,QAOSLINE=QAOSLINE+1
- SCRN ;
- S QAOSUPLD(QAOSLINE)="SCRN",QAOSLINE=QAOSLINE+1,QAOSSEQ=0
- F S QAOSSEQ=$O(^UTILITY($J,"QAOSPSM","N",QAOSSEQ)) Q:QAOSSEQ'>0 D
- . S QAOSDATA=^UTILITY($J,"QAOSPSM","N",QAOSSEQ)
- . S QAOSSCRN=$P(QAOSDATA,"^")
- . S X=QAOSSCRN_"^"
- . F QA=2:1:9 S X=X_+$P(QAOSDATA,"^",QA)_"^"
- . I "^1^4^"[("^"_QAOSSEQ_"^") S QAOSSPEC="1^2^3^4^5"
- . I QAOSSEQ=2 S QAOSSPEC="N/A^N/A^N/A^N/A^5"
- . I QAOSSEQ=3 S QAOSSPEC="N/A^2^N/A^N/A^2"
- . S X=X_$$SERVICE(QAOSSEQ,QAOSSPEC)_"^"
- . S QAOSUPLD(QAOSLINE)=X,QAOSLINE=QAOSLINE+1
- . Q
- Q
- ;
- SERVICE(SEQUENCE,PATTERN) ;
- N QA F QA=1:1:5 D
- . S PATTERN(0)=$P(PATTERN,"^",QA)
- . Q:PATTERN(0)="N/A"
- . S $P(PATTERN,"^",QA)=+$P($G(QAOSRV("N",SEQUENCE)),"^",PATTERN(0))
- . Q
- Q PATTERN
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HQAOSUPL2 3792 printed Feb 18, 2025@23:48:40 Page 2
- QAOSUPL2 ;HISC/DAD-GENERATE SUMMARY OF OS UPLOAD BULLETIN ;10/7/93 11:01
- +1 ;;3.0;Occurrence Screen;**3**;09/14/1993
- EN ;
- +1 DO KILL^XM
- +2 SET XMSUB="SUMMARY OF OCCURRENCE SCREEN"
- +3 SET XMDUZ=QAOSSITE
- SET XMTEXT="QAOSUPLD("
- +4 SET XMY(QAOSSERV_"@"_QAOSDOM)=""
- ASKMAIL ;
- +1 WRITE @IOF
- +2 WRITE !,"Reporting period: ",QAQ2HED
- +3 WRITE !!,"Results of Reliability Assessments."
- +4 WRITE !?5,"Date clinical review reliability assessment completed:"
- +5 SET Y=QAOSRELY("C",1)
- XECUTE ^DD("DD")
- WRITE ?69,$SELECT(Y]"":Y,1:"N/A")
- +6 WRITE !?5,"Percentage agreement found:"
- +7 SET Y=QAOSRELY("C",2)
- WRITE ?69,$SELECT(Y]"":$JUSTIFY(Y,6,2)_"%",1:"N/A")
- +8 WRITE !?5,"Date peer review reliability assessment completed: "
- +9 SET Y=QAOSRELY("P",1)
- XECUTE ^DD("DD")
- WRITE ?69,$SELECT(Y]"":Y,1:"N/A")
- +10 WRITE !?5,"Percentage agreement found:"
- +11 SET Y=QAOSRELY("P",2)
- WRITE ?69,$SELECT(Y]"":$JUSTIFY(Y,6,2)_"%",1:"N/A")
- +12 WRITE !!,"Facility Workload Data."
- +13 WRITE !?5,"Number of admissions to acute care by bed section."
- +14 WRITE !?10,"Medicine (Include Neurology, exclude Intermediate Med.):"
- +15 SET Y=QAOSWORK(1)
- WRITE ?66,$SELECT(Y]"":$JUSTIFY(Y,6),1:" N/A")
- +16 WRITE !?10,"Surgery:"
- SET Y=QAOSWORK(2)
- WRITE ?66,$SELECT(Y]"":$JUSTIFY(Y,6),1:" N/A")
- +17 WRITE !?10,"Psychiatry:"
- SET Y=QAOSWORK(3)
- WRITE ?66,$SELECT(Y]"":$JUSTIFY(Y,6),1:" N/A")
- +18 WRITE !?5,"Number of ""Unscheduled"" and ""10-10"" ambulatory care visits:"
- +19 SET Y=QAOSWORK(4)
- WRITE ?66,$SELECT(Y]"":$JUSTIFY(Y,6),1:" N/A")
- +20 WRITE !?5,"Number of surgical procedures performed:"
- +21 SET Y=QAOSWORK(7)
- WRITE ?66,$SELECT(Y]"":$JUSTIFY(Y,6),1:" N/A")
- +22 ;
- +23 WRITE !!,"WARNING: This data will overwrite your pre-existing data"
- +24 WRITE !," at the NQADB for this semi-annual period !!"
- +25 WRITE !!,"Ready to send the ",XMSUB," data to the National Quality"
- +26 WRITE !,"Assurance DataBase (NQADB) at ",QAOSSERV,"@",QAOSDOM
- +27 WRITE !,"OK to send"
- SET %=2
- DO YN^DICN
- if (%=-1)!(%=2)
- GOTO EXIT
- +28 IF '%
- WRITE !!?5,"Please answer Y(es) or N(o) "
- READ QA:5
- GOTO ASKMAIL
- +29 WRITE !,"Sending . . ."
- DO BUILD
- DO ^XMD
- EXIT ;
- +1 KILL %,ERROR,QA,QAOERROR,QAOSDATA,QAOSDOM,QAOSLIST,QAOSSCRN,QAOSSEQ
- +2 KILL QAOSSERV,QAOSSITE,QAOSSTNO,QAOSUPLD,QAOSZERO,QAO,QAOS,QAOSCLIN,QAOSCRN
- +3 KILL QAOSD0,QAOSDATE,QAOSFIND,QAOSLINE,QAOSMGMT,QAOSNUM,QAOSPEER,QAOSRELY
- +4 KILL QAOSRFPR,QAOSSPEC,QAOSWORK,QAOFINAL,QAOSACTN,QAOSCREV,QAOSD1,QAOSHOSP
- +5 KILL QAOSLEVL,QAOSRV,QAOSS1,QAOSS2,QAOSSTAT,QAOSTEMP,QAOSWARD,SERV
- +6 KILL ^UTILITY($JOB,"QAOSPSM"),^UTILITY($JOB,"QAOSXREF"),^UTILITY($JOB,"QAOSPEND")
- +7 DO K^QAQDATE
- DO KILL^XM
- if $DATA(ZTQUEUED)
- SET ZTREQ="@"
- +8 QUIT
- BUILD ;
- +1 SET QAOSLIST(0)="1,"
- DO ^QAOSPSM0
- +2 KILL QAOSUPLD
- SET QAOSLINE=1
- SERVER ;
- +1 SET QAOSUPLD(QAOSLINE)="^^QAO0^"
- SET QAOSLINE=QAOSLINE+1
- SITE ;
- +1 SET QAOSUPLD(QAOSLINE)="SITE"
- SET QAOSLINE=QAOSLINE+1
- +2 SET QAOSUPLD(QAOSLINE)=QAOSSTNO_"^"_QAOSSITE_"^"_QAQNBEG_"^"_QAQNEND_"^"
- +3 SET QAOSLINE=QAOSLINE+1
- RELY ;
- +1 SET QAOSUPLD(QAOSLINE)="RELY"
- SET QAOSLINE=QAOSLINE+1
- +2 SET X=QAOSRELY("C",1)_"^"_QAOSRELY("C",2)_"^"
- +3 SET X=X_QAOSRELY("P",1)_"^"_QAOSRELY("P",2)_"^"
- +4 SET QAOSUPLD(QAOSLINE)=X
- SET QAOSLINE=QAOSLINE+1
- WORK ;
- +1 SET QAOSUPLD(QAOSLINE)="WORK"
- SET QAOSLINE=QAOSLINE+1
- SET X=""
- +2 FOR QA=1:1:7
- SET X=X_QAOSWORK(QA)_"^"
- +3 SET QAOSUPLD(QAOSLINE)=X
- SET QAOSLINE=QAOSLINE+1
- ACTN ;
- +1 SET QAOSUPLD(QAOSLINE)="ACTN"
- SET QAOSLINE=QAOSLINE+1
- SET X=""
- +2 FOR QA=8:1:22
- SET X=X_QA_";"_+$GET(QAOSACTN("N",QA))_"^"
- +3 SET QAOSUPLD(QAOSLINE)=X
- SET QAOSLINE=QAOSLINE+1
- SCRN ;
- +1 SET QAOSUPLD(QAOSLINE)="SCRN"
- SET QAOSLINE=QAOSLINE+1
- SET QAOSSEQ=0
- +2 FOR
- SET QAOSSEQ=$ORDER(^UTILITY($JOB,"QAOSPSM","N",QAOSSEQ))
- if QAOSSEQ'>0
- QUIT
- Begin DoDot:1
- +3 SET QAOSDATA=^UTILITY($JOB,"QAOSPSM","N",QAOSSEQ)
- +4 SET QAOSSCRN=$PIECE(QAOSDATA,"^")
- +5 SET X=QAOSSCRN_"^"
- +6 FOR QA=2:1:9
- SET X=X_+$PIECE(QAOSDATA,"^",QA)_"^"
- +7 IF "^1^4^"[("^"_QAOSSEQ_"^")
- SET QAOSSPEC="1^2^3^4^5"
- +8 IF QAOSSEQ=2
- SET QAOSSPEC="N/A^N/A^N/A^N/A^5"
- +9 IF QAOSSEQ=3
- SET QAOSSPEC="N/A^2^N/A^N/A^2"
- +10 SET X=X_$$SERVICE(QAOSSEQ,QAOSSPEC)_"^"
- +11 SET QAOSUPLD(QAOSLINE)=X
- SET QAOSLINE=QAOSLINE+1
- +12 QUIT
- End DoDot:1
- +13 QUIT
- +14 ;
- SERVICE(SEQUENCE,PATTERN) ;
- +1 NEW QA
- FOR QA=1:1:5
- Begin DoDot:1
- +2 SET PATTERN(0)=$PIECE(PATTERN,"^",QA)
- +3 if PATTERN(0)="N/A"
- QUIT
- +4 SET $PIECE(PATTERN,"^",QA)=+$PIECE($GET(QAOSRV("N",SEQUENCE)),"^",PATTERN(0))
- +5 QUIT
- End DoDot:1
- +6 QUIT PATTERN