- 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 Feb 18, 2025@23:48:38 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