90 lines
3.7 KiB
Mathematica
90 lines
3.7 KiB
Mathematica
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
|