source: FOIAVistA/trunk/r/OCCURRENCE_SCREEN-QAO/QAOSUPL0.m@ 1397

QAOSUPL0 ;HISC/DAD-GENERATE SUMMARY OF OS UPLOAD BULLETIN ;6/28/93  11:07
 ;;3.0;Occurrence Screen;;09/14/1993
 ;
 ;MESSAGE FORMAT:
 ; SERVER DATA
 ;   1)  ^^QAO0^
 ; SITE DATA
 ;   1)  STATION NUMBER (FROM: 4,99)
 ;   2)  STATION NAME   (FROM: 4,.01)
 ;   3)  REPORTING PERIOD START DATE (FM INTERNAL)
 ;   4)  REPORTING PERIOD END DATE   (FM INTERNAL)
 ; RELIABILITY DATA
 ;   1)  DATE CLIN RELIABILITY ASSESSMENT COMPLETED (FM INTERNAL)
 ;   2)  PERCENTAGE AGREEMENT FOUND (CLIN)
 ;   3)  DATE PEER RELIABILITY ASSESSMENT COMPLETED (FM INTERNAL)
 ;   4)  PERCENTAGE AGREEMENT FOUND (PEER)
 ; WORKLOAD DATA
 ;   1)  # ADMISSIONS TO MEDICINE
 ;   2)  # ADMISSIONS TO SURGERY
 ;   3)  # ADMISSIONS TO PSYCHIATRY
 ;   4)  # UNSCHEDULED & 10-10 AMBULATORY CARE VISITS
 ;   5)  <NULL>
 ;   6)  <NULL>
 ;   7)  # SURGICAL PROCEDURES PERFORMED
 ; ACTION DATA
 ;   1)  ACTION NUMBER (FROM: 741.7,.01) ; NUMBER OF TIMES TAKEN ^ ...
 ; SCREEN DATA
 ;   1)  SCREEN NUMBER (FROM: 741.1,.01 - NATIONAL SCREENS ONLY)
 ;   2)  # OCCURRENCES REVIEWED CLINICALLY
 ;   3)  # OCCURRENCES REFERRED TO PEER REVIEW
 ;   4)  OUTCOME OF PEER REVIEW: LEVEL 1
 ;   5)  OUTCOME OF PEER REVIEW: LEVEL 2
 ;   6)  OUTCOME OF PEER REVIEW: LEVEL 3
 ;   7)  OUTCOME OF PEER REVIEW: PENDING
 ;   8)  # OCCURRENCES REFERRED FOR SYSTEM ISSUES
 ;   9)  # OCCURRENCES REFERRED FOR EQUIPMENT ISSUES
 ;  10)  # OCCURRENCES MEDICINE (INCLUDING NEUROLOGY)
 ;  11)  # OCCURRENCES SURGERY
 ;  12)  # OCCURRENCES PSYCHIATRY
 ;  13)  # OCCURRENCES OTHER
 ;  14)  # OCCURRENCES TOTAL
EN ;
 S QAOSZERO=$G(^QA(740,1,0)) I +QAOSZERO'>0 S QAOERROR=1 D ERROR G EXIT
 S QAOSSITE=$P($G(^DIC(4,+QAOSZERO,0)),"^")
 I QAOSSITE="" S QAOERROR=2 D ERROR G EXIT
 S QAOSSTNO=$P($G(^DIC(4,+QAOSZERO,99)),"^")
 I QAOSSTNO="" S QAOERROR=3 D ERROR G EXIT
 S QAOSSERV=$P(QAOSZERO,"^",4) I QAOSSERV="" S QAOERROR=4 D ERROR G EXIT
 S QAOSDOM=$P(QAOSZERO,"^",5) I QAOSDOM="" S QAOERROR=5 D ERROR G EXIT
 S QA=+$O(^DIC(4.2,"B",$E(QAOSDOM,1,30),0))
 I $S($D(^DIC(4.2,QA,0))[0:1,$P(^(0),"^")'=QAOSDOM:1,1:0) S QAOERROR=6 D ERROR G EXIT
 W !!,"Select the reporting period:" S QAQDATE="'S" D ^QAQDATE
 G:QAQQUIT EXIT
 ;
 D HOME^%ZIS W @IOF
 W !!,"3.  Results of the Reliability Assessments (Complete only for second report",!,"of fiscal year.)"
 ;
 W !!,"   a.  Clinical Review"
 K DIR S DIR(0)="DOA^:"_DT_":EXP"
 S DIR("?")="Enter an exact date (month, day, and year) less than or equal to today"
 S DIR("A")="      (1)  Date reliability assessment completed: "
 W ! D ^DIR G:$D(DTOUT)!$D(DUOUT)!$D(DIROUT) EXIT S QAOSRELY("C",1)=Y
 K DIR S DIR(0)="NOA^0:100:2"
 S DIR("?")="Enter a number from 0 to 100, two decimal places allowed, no '%'"
 S DIR("A")="      (2)  Percentage agreement found: "
 W ! D ^DIR G:$D(DTOUT)!$D(DUOUT)!$D(DIROUT) EXIT S QAOSRELY("C",2)=Y
 ;
 W !!,"   b.  Peer Review"
 K DIR S DIR(0)="DOA^:"_DT_":EXP"
 S DIR("?")="Enter an exact date (month, day, and year) less than or equal to today"
 S DIR("A")="      (1)  Date reliability assessment completed: "
 W ! D ^DIR G:$D(DTOUT)!$D(DUOUT)!$D(DIROUT) EXIT S QAOSRELY("P",1)=Y
 K DIR S DIR(0)="NOA^0:100:2"
 S DIR("?")="Enter a number from 0 to 100, two decimal places allowed, no '%'"
 S DIR("A")="      (2)  Percentage agreement found: "
 W ! D ^DIR G:$D(DTOUT)!$D(DUOUT)!$D(DIROUT) EXIT S QAOSRELY("P",2)=Y
 G EN^QAOSUPL1
EXIT ;
 G EXIT^QAOSUPL2
ERROR ;
 W *7,!!,"*** ",$P($T(ERR+QAOERROR),";;",2)," ***",!!,*7
 Q
ERR ;;ERROR MESSAGES: REASONS SUMMARY OF OCCURRENCE SCREEN COULD NOT BE SENT
 ;;STATION NAME NOT FOUND IN QA SITE PARAMETERS FILE
 ;;STATION NAME NOT FOUND IN INSTITUTION FILE
 ;;STATION NUMBER NOT FOUND IN INSTITUTION FILE
 ;;NQADB MAIL GROUP/SERVER NOT FOUND IN QA SITE PARAMETERS FILE
 ;;NQADB DOMAIN NOT FOUND IN QA SITE PARAMETERS FILE
 ;;NQADB DOMAIN NOT FOUND IN DOMAIN FILE