VistA-FOIAVistA/r/OCCURRENCE_SCREEN-QAO/QAOSUPL0.m

90 lines
3.7 KiB
Mathematica
Raw Normal View History

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