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

QAOSUPL2.m

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