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 Apr 09, 2024@21:23:36 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
