- QAOSAHOC ;HISC/DAD-AD HOC REPORT INTERFACE FOR THE QA OCCURRENCE SCREEN FILE (#741) ;7/9/93 13:28
- ;;3.0;Occurrence Screen;;09/14/1993
- EN ;
- S QAQMRTN="MENU^QAOSAHO2",QAQORTN="OTHER^QAOSAHOC",QAQDIC=741
- S QAQMHDR="Occurrence Screen"
- D ^QAQAHOC0
- K QAOSCLIN,QAOSEXCP,QAQFOUND
- Q
- OTHER ;
- K DIS S QA=0
- O1 W !!?3,"Do you want the report to include 'deleted' records"
- S %=2 D YN^DICN I %=-1 S QAQQUIT=1 Q
- I %=0 W !!?5,"Please answer Y(es) or N(o)" G O1
- I %=2 S DIS(QA)="I $P(^QA(741,D0,0),""^"",11)'=2",QA=1
- O2 W !!?3,"Do you want the report to include 'exception to criteria' records"
- S %=2 D YN^DICN I %=-1 S QAQQUIT=1 Q
- I %'>0 W !!?5,"Please answer Y(es) or N(o)" G O2
- I %=2 D
- . S QAOSCLIN=+$O(^QA(741.2,"C",1,0)),QAOSEXCP=+$O(^QA(741.6,"B",3,0))
- . S DIS(QA)="I QAOSEXCP'=$P($G(^QA(741,D0,""REVR"",+$O(^QA(741,D0,""REVR"",""B"",QAOSCLIN,0)),0)),""^"",5)"
- . Q
- O3 K QAQFOUND S QAQFOUND=0,DHIT="S QAQFOUND=1"
- S DIOEND="I 'QAQFOUND W !!,""No data found for this report !!"""
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HQAOSAHOC 1010 printed Feb 18, 2025@23:47:40 Page 2
- QAOSAHOC ;HISC/DAD-AD HOC REPORT INTERFACE FOR THE QA OCCURRENCE SCREEN FILE (#741) ;7/9/93 13:28
- +1 ;;3.0;Occurrence Screen;;09/14/1993
- EN ;
- +1 SET QAQMRTN="MENU^QAOSAHO2"
- SET QAQORTN="OTHER^QAOSAHOC"
- SET QAQDIC=741
- +2 SET QAQMHDR="Occurrence Screen"
- +3 DO ^QAQAHOC0
- +4 KILL QAOSCLIN,QAOSEXCP,QAQFOUND
- +5 QUIT
- OTHER ;
- +1 KILL DIS
- SET QA=0
- O1 WRITE !!?3,"Do you want the report to include 'deleted' records"
- +1 SET %=2
- DO YN^DICN
- IF %=-1
- SET QAQQUIT=1
- QUIT
- +2 IF %=0
- WRITE !!?5,"Please answer Y(es) or N(o)"
- GOTO O1
- +3 IF %=2
- SET DIS(QA)="I $P(^QA(741,D0,0),""^"",11)'=2"
- SET QA=1
- O2 WRITE !!?3,"Do you want the report to include 'exception to criteria' records"
- +1 SET %=2
- DO YN^DICN
- IF %=-1
- SET QAQQUIT=1
- QUIT
- +2 IF %'>0
- WRITE !!?5,"Please answer Y(es) or N(o)"
- GOTO O2
- +3 IF %=2
- Begin DoDot:1
- +4 SET QAOSCLIN=+$ORDER(^QA(741.2,"C",1,0))
- SET QAOSEXCP=+$ORDER(^QA(741.6,"B",3,0))
- +5 SET DIS(QA)="I QAOSEXCP'=$P($G(^QA(741,D0,""REVR"",+$O(^QA(741,D0,""REVR"",""B"",QAOSCLIN,0)),0)),""^"",5)"
- +6 QUIT
- End DoDot:1
- O3 KILL QAQFOUND
- SET QAQFOUND=0
- SET DHIT="S QAQFOUND=1"
- +1 SET DIOEND="I 'QAQFOUND W !!,""No data found for this report !!"""
- +2 QUIT
