QANUTL7 ;HISC/GJC-SPECIAL INCIDENTS INVOL. A BENEFICIARY ;3/8/92
;;2.0;Incident Reporting;;08/07/1992
;
EN1 ;Format of the print for our Patient/Incident Inquiry
F QANW=0:0 S QANW=$O(^UTILITY("DIQ1",$J,QANW)) Q:QANW'>0 D CHECK Q:QANQUIT
Q
CHECK ;Check for multiples.
I QANW=742.01!(QANW=742.02)!(QANW=742.42) D MULT Q
F QANX=0:0 S QANX=$O(^UTILITY("DIQ1",$J,QANW,QANX)) Q:QANX'>0!(QANQUIT) F QANY=0:0 S QANY=$O(^UTILITY("DIQ1",$J,QANW,QANX,QANY)) Q:QANY'>0 D CHEX Q:QANQUIT
Q
CHEX ;Check for word processing fields
I QANW=742.4,(QANY=.05!(QANY=.2)) D WORD Q
S QANDD=$G(^DD(QANW,QANY,0)) Q:QANDD']""
S QANUTIL=$G(^UTILITY("DIQ1",$J,QANW,QANX,QANY,"E"))
W !,$P(QANDD,U)_": "_$P(QANUTIL,U)
D:$Y>(IOSL-4) HDH
Q
HDH ;Header for our data inquiry.
I $E(IOST)="C" K DIR S DIR(0)="E" D ^DIR K DIR S:+Y=0 QANQUIT=1
Q:QANQUIT D HDR^QANUTL6
Q
MULT ;Text for multiples
F QANX=0:0 S QANX=$O(^UTILITY("DIQ1",$J,QANW,QANX)) Q:QANX'>0!(QANQUIT) F QANY=0:0 S QANY=$O(^UTILITY("DIQ1",$J,QANW,QANX,QANY)) Q:QANY'>0 D MULT1 Q:QANQUIT
Q
MULT1 ;Data inquiry.
S QANDD=$G(^DD(QANW,QANY,0)) Q:QANDD']""
S QANUTIL=$G(^UTILITY("DIQ1",$J,QANW,QANX,QANY,"E"))
W !,$P(QANDD,U)_" ("_QANX_") "_$P(QANUTIL,U)
D:$Y>(IOSL-4) HDH Q:QANQUIT
Q
WORD ;Output for word processing.
S QANDD=$G(^DD(QANW,QANY,0)) Q:QANDD']""
W !,$P(QANDD,U)_": "
F QANZ=0:0 S QANZ=$O(^UTILITY("DIQ1",$J,QANW,QANX,QANY,QANZ)) Q:QANZ'>0!(QANQUIT) W !,QANZ_": "_^UTILITY("DIQ1",$J,QANW,QANX,QANY,QANZ) D:$Y>(IOSL-4) HDH Q:QANQUIT
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HQANUTL7 1536 printed Apr 09, 2024@21:01:21 Page 2
QANUTL7 ;HISC/GJC-SPECIAL INCIDENTS INVOL. A BENEFICIARY ;3/8/92
+1 ;;2.0;Incident Reporting;;08/07/1992
+2 ;
EN1 ;Format of the print for our Patient/Incident Inquiry
+1 FOR QANW=0:0
SET QANW=$ORDER(^UTILITY("DIQ1",$JOB,QANW))
if QANW'>0
QUIT
DO CHECK
if QANQUIT
QUIT
+2 QUIT
CHECK ;Check for multiples.
+1 IF QANW=742.01!(QANW=742.02)!(QANW=742.42)
DO MULT
QUIT
+2 FOR QANX=0:0
SET QANX=$ORDER(^UTILITY("DIQ1",$JOB,QANW,QANX))
if QANX'>0!(QANQUIT)
QUIT
FOR QANY=0:0
SET QANY=$ORDER(^UTILITY("DIQ1",$JOB,QANW,QANX,QANY))
if QANY'>0
QUIT
DO CHEX
if QANQUIT
QUIT
+3 QUIT
CHEX ;Check for word processing fields
+1 IF QANW=742.4
IF (QANY=.05!(QANY=.2))
DO WORD
QUIT
+2 SET QANDD=$GET(^DD(QANW,QANY,0))
if QANDD']""
QUIT
+3 SET QANUTIL=$GET(^UTILITY("DIQ1",$JOB,QANW,QANX,QANY,"E"))
+4 WRITE !,$PIECE(QANDD,U)_": "_$PIECE(QANUTIL,U)
+5 if $Y>(IOSL-4)
DO HDH
+6 QUIT
HDH ;Header for our data inquiry.
+1 IF $EXTRACT(IOST)="C"
KILL DIR
SET DIR(0)="E"
DO ^DIR
KILL DIR
if +Y=0
SET QANQUIT=1
+2 if QANQUIT
QUIT
DO HDR^QANUTL6
+3 QUIT
MULT ;Text for multiples
+1 FOR QANX=0:0
SET QANX=$ORDER(^UTILITY("DIQ1",$JOB,QANW,QANX))
if QANX'>0!(QANQUIT)
QUIT
FOR QANY=0:0
SET QANY=$ORDER(^UTILITY("DIQ1",$JOB,QANW,QANX,QANY))
if QANY'>0
QUIT
DO MULT1
if QANQUIT
QUIT
+2 QUIT
MULT1 ;Data inquiry.
+1 SET QANDD=$GET(^DD(QANW,QANY,0))
if QANDD']""
QUIT
+2 SET QANUTIL=$GET(^UTILITY("DIQ1",$JOB,QANW,QANX,QANY,"E"))
+3 WRITE !,$PIECE(QANDD,U)_" ("_QANX_") "_$PIECE(QANUTIL,U)
+4 if $Y>(IOSL-4)
DO HDH
if QANQUIT
QUIT
+5 QUIT
WORD ;Output for word processing.
+1 SET QANDD=$GET(^DD(QANW,QANY,0))
if QANDD']""
QUIT
+2 WRITE !,$PIECE(QANDD,U)_": "
+3 FOR QANZ=0:0
SET QANZ=$ORDER(^UTILITY("DIQ1",$JOB,QANW,QANX,QANY,QANZ))
if QANZ'>0!(QANQUIT)
QUIT
WRITE !,QANZ_": "_^UTILITY("DIQ1",$JOB,QANW,QANX,QANY,QANZ)
if $Y>(IOSL-4)
DO HDH
if QANQUIT
QUIT
+4 QUIT
