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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HQAOSUPL0 3888 printed Nov 22, 2024@17:32:11 Page 2
QAOSUPL0 ;HISC/DAD-GENERATE SUMMARY OF OS UPLOAD BULLETIN ;6/28/93 11:07
+1 ;;3.0;Occurrence Screen;;09/14/1993
+2 ;
+3 ;MESSAGE FORMAT:
+4 ; SERVER DATA
+5 ; 1) ^^QAO0^
+6 ; SITE DATA
+7 ; 1) STATION NUMBER (FROM: 4,99)
+8 ; 2) STATION NAME (FROM: 4,.01)
+9 ; 3) REPORTING PERIOD START DATE (FM INTERNAL)
+10 ; 4) REPORTING PERIOD END DATE (FM INTERNAL)
+11 ; RELIABILITY DATA
+12 ; 1) DATE CLIN RELIABILITY ASSESSMENT COMPLETED (FM INTERNAL)
+13 ; 2) PERCENTAGE AGREEMENT FOUND (CLIN)
+14 ; 3) DATE PEER RELIABILITY ASSESSMENT COMPLETED (FM INTERNAL)
+15 ; 4) PERCENTAGE AGREEMENT FOUND (PEER)
+16 ; WORKLOAD DATA
+17 ; 1) # ADMISSIONS TO MEDICINE
+18 ; 2) # ADMISSIONS TO SURGERY
+19 ; 3) # ADMISSIONS TO PSYCHIATRY
+20 ; 4) # UNSCHEDULED & 10-10 AMBULATORY CARE VISITS
+21 ; 5) <NULL>
+22 ; 6) <NULL>
+23 ; 7) # SURGICAL PROCEDURES PERFORMED
+24 ; ACTION DATA
+25 ; 1) ACTION NUMBER (FROM: 741.7,.01) ; NUMBER OF TIMES TAKEN ^ ...
+26 ; SCREEN DATA
+27 ; 1) SCREEN NUMBER (FROM: 741.1,.01 - NATIONAL SCREENS ONLY)
+28 ; 2) # OCCURRENCES REVIEWED CLINICALLY
+29 ; 3) # OCCURRENCES REFERRED TO PEER REVIEW
+30 ; 4) OUTCOME OF PEER REVIEW: LEVEL 1
+31 ; 5) OUTCOME OF PEER REVIEW: LEVEL 2
+32 ; 6) OUTCOME OF PEER REVIEW: LEVEL 3
+33 ; 7) OUTCOME OF PEER REVIEW: PENDING
+34 ; 8) # OCCURRENCES REFERRED FOR SYSTEM ISSUES
+35 ; 9) # OCCURRENCES REFERRED FOR EQUIPMENT ISSUES
+36 ; 10) # OCCURRENCES MEDICINE (INCLUDING NEUROLOGY)
+37 ; 11) # OCCURRENCES SURGERY
+38 ; 12) # OCCURRENCES PSYCHIATRY
+39 ; 13) # OCCURRENCES OTHER
+40 ; 14) # OCCURRENCES TOTAL
EN ;
+1 SET QAOSZERO=$GET(^QA(740,1,0))
IF +QAOSZERO'>0
SET QAOERROR=1
DO ERROR
GOTO EXIT
+2 SET QAOSSITE=$PIECE($GET(^DIC(4,+QAOSZERO,0)),"^")
+3 IF QAOSSITE=""
SET QAOERROR=2
DO ERROR
GOTO EXIT
+4 SET QAOSSTNO=$PIECE($GET(^DIC(4,+QAOSZERO,99)),"^")
+5 IF QAOSSTNO=""
SET QAOERROR=3
DO ERROR
GOTO EXIT
+6 SET QAOSSERV=$PIECE(QAOSZERO,"^",4)
IF QAOSSERV=""
SET QAOERROR=4
DO ERROR
GOTO EXIT
+7 SET QAOSDOM=$PIECE(QAOSZERO,"^",5)
IF QAOSDOM=""
SET QAOERROR=5
DO ERROR
GOTO EXIT
+8 SET QA=+$ORDER(^DIC(4.2,"B",$EXTRACT(QAOSDOM,1,30),0))
+9 IF $SELECT($DATA(^DIC(4.2,QA,0))[0:1,$PIECE(^(0),"^")'=QAOSDOM:1,1:0)
SET QAOERROR=6
DO ERROR
GOTO EXIT
+10 WRITE !!,"Select the reporting period:"
SET QAQDATE="'S"
DO ^QAQDATE
+11 if QAQQUIT
GOTO EXIT
+12 ;
+13 DO HOME^%ZIS
WRITE @IOF
+14 WRITE !!,"3. Results of the Reliability Assessments (Complete only for second report",!,"of fiscal year.)"
+15 ;
+16 WRITE !!," a. Clinical Review"
+17 KILL DIR
SET DIR(0)="DOA^:"_DT_":EXP"
+18 SET DIR("?")="Enter an exact date (month, day, and year) less than or equal to today"
+19 SET DIR("A")=" (1) Date reliability assessment completed: "
+20 WRITE !
DO ^DIR
if $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
GOTO EXIT
SET QAOSRELY("C",1)=Y
+21 KILL DIR
SET DIR(0)="NOA^0:100:2"
+22 SET DIR("?")="Enter a number from 0 to 100, two decimal places allowed, no '%'"
+23 SET DIR("A")=" (2) Percentage agreement found: "
+24 WRITE !
DO ^DIR
if $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
GOTO EXIT
SET QAOSRELY("C",2)=Y
+25 ;
+26 WRITE !!," b. Peer Review"
+27 KILL DIR
SET DIR(0)="DOA^:"_DT_":EXP"
+28 SET DIR("?")="Enter an exact date (month, day, and year) less than or equal to today"
+29 SET DIR("A")=" (1) Date reliability assessment completed: "
+30 WRITE !
DO ^DIR
if $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
GOTO EXIT
SET QAOSRELY("P",1)=Y
+31 KILL DIR
SET DIR(0)="NOA^0:100:2"
+32 SET DIR("?")="Enter a number from 0 to 100, two decimal places allowed, no '%'"
+33 SET DIR("A")=" (2) Percentage agreement found: "
+34 WRITE !
DO ^DIR
if $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
GOTO EXIT
SET QAOSRELY("P",2)=Y
+35 GOTO EN^QAOSUPL1
EXIT ;
+1 GOTO EXIT^QAOSUPL2
ERROR ;
+1 WRITE *7,!!,"*** ",$PIECE($TEXT(ERR+QAOERROR),";;",2)," ***",!!,*7
+2 QUIT
ERR ;;ERROR MESSAGES: REASONS SUMMARY OF OCCURRENCE SCREEN COULD NOT BE SENT
+1 ;;STATION NAME NOT FOUND IN QA SITE PARAMETERS FILE
+2 ;;STATION NAME NOT FOUND IN INSTITUTION FILE
+3 ;;STATION NUMBER NOT FOUND IN INSTITUTION FILE
+4 ;;NQADB MAIL GROUP/SERVER NOT FOUND IN QA SITE PARAMETERS FILE
+5 ;;NQADB DOMAIN NOT FOUND IN QA SITE PARAMETERS FILE
+6 ;;NQADB DOMAIN NOT FOUND IN DOMAIN FILE
