INHMGD8 ;CAR; 25 Apr 97 16:56;HL7 MESSAGING - PRINT SENSITIVITY ANALYSIS
;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
;COPYRIGHT 1991-2000 SAIC
;
; MODULE NAME:
; HL7 Messaging - Print Sensitivity Analysis (INHMGD8).
;
; PURPOSE:
; Module INHMGD8 is used to print a Sensitivity Analysis
;
INSPRNT(INSENS,INALL) ;Print the data
;Print from an array of requested file,field pairs or print ALL
; e.g. INSENS(2,.03)="",INSENS(2,.04)="",...INSENS(8550,.01)=""
;Inputs:
; INSENS = 1 for Sensitivity Analysis (SA), 0 for no (SA)
; INSENS(n,m) = array of requested file,field pairs
; INALL = 1 for SA for ALL, 0 for not ALL
;
N IN7F,IN7M,IN7S,IND,INDATAA,INQ,INFIL,INFILT,INFLD,INFLDT
N INFSO,INHDR,INIOM2,INIOM3,INJ,INMAX,INWAIT,INH
;
U IO
S INDATA="$C(32)"
;
;setup some text constants
S INH(1)="HL7 Messaging Data Sources"
S INH(2)=" Sensitivity Analysis"
S INH(3)="-----Corresponding HL7: Message/Segment/Field Names"
;
D ;setup Data printing format, based on page width (IOM)
.;------------------------------------------------------------
.I IOM<96 D Q ;set up for an 80 character line
..S IND(1)="$E("" ""_IN7M,1,60)"
..S IND(2)="$E("" ""_IN7S,1,42),?44,$E(IN7F,1,36)"
..;S IND(3)="$C(32)"
.;------------------------------------------------------------
.I IOM<132 D Q ;set up for a 96 character line
..S IND(1)="$E("" ""_IN7M,1,60)"
..S IND(2)="$E("" ""_IN7S,1,45),?48,$E(IN7F,1,48)"
.;------------------------------------------------------------
.;IOM is 132; set up for a 132 character line
.S IND(1)="$E("" ""_IN7M,1,44),?46,$E(IN7S,1,42),?90,$E(IN7F,1,42)"
;
;setup header lines
S INHDR(1)="INH(1),INH(2),?(IOM-30),INDT,?(IOM-10),""PAGE: "",INPAGE"
S INHDR(2)="""Field#/Name"",?$S(IOM>96:IOM\3+2,IOM>80:IOM\2-3,1:IOM\2-3),""File Number/Name"""
S INHDR(3)="INH(3)_$$DASH^INHMGD1(IOM-54)"
S INHDR(4)="INFLD_"" "",?6,INFLDT,?$S(IOM>96:IOM\3,1:IOM\2-5),"" File: ""_$J(INFIL,7)_"" ""_INFILT"
;
;begin printing
;
;check for individual file,field SA
I $O(INSENS(0)),'INALL D
.S INFIL=0 F S INFIL=$O(INSENS(INFIL)) Q:'INFIL!$G(DUOUT) D
..S INFLD=0 F S INFLD=$O(INSENS(INFIL,INFLD)) Q:'INFLD!$G(DUOUT) D
...S INFILT=$P($G(^DIC(INFIL,0)),U)
...S:INFILT="" INFILT=$P($G(^DD(INFIL,0)),U)
...S INFLDT=$P($G(^DD(INFIL,INFLD,0)),U)
...D PHEADER(4,.INHDR)
...S INQ="^UTILITY(""INHMGD"","_$J_",""A"","_INFIL_","_INFLD_")"
...F S INQ=$Q(@INQ) Q:$QS(INQ,4)'=INFIL!($QS(INQ,5)'=INFLD)!$G(DUOUT) D
....S IN7F=$P($G(^INTHL7F(+$QS(INQ,6),0)),U) Q:$$INERS(3)
....S IN7S=$P($G(^INTHL7S(+$QS(INQ,7),0)),U) Q:$$INERS(4)
....S IN7M=$P($G(^INTHL7M(+$QS(INQ,8),0)),U) Q:$$INERS(5)
....S INJ=0 F S INJ=$O(IND(INJ)) Q:'INJ D
.....S INDATA=IND(INJ) D INW(INJ=1)
;
;check for SA on ALL file,field pairs
I INALL D
.S INFSO=0 ;store the old sum (should change with new INFIL or INFLD)
.S INQ="^UTILITY(""INHMGD"","_$J_",""A"")"
.F S INQ=$Q(@INQ) Q:$QS(INQ,3)'["A"!$G(DUOUT) D
..S INFIL=$QS(INQ,4) Q:$$INERS(1)
..S INFLD=$QS(INQ,5) Q:$$INERS(2)
..I INFIL+INFLD'=INFSO D
...S INFILT=$P($G(^DIC(INFIL,0)),U)
...S:INFILT="" INFILT=$P($G(^DD(INFIL,0)),U)
...S INFLDT=$P($G(^DD(INFIL,INFLD,0)),U)
...D PHEADER(4,.INHDR)
..S INFSO=INFIL+INFLD
..S IN7F=$P($G(^INTHL7F(+$QS(INQ,6),0)),U) Q:$$INERS(3)
..S IN7S=$P($G(^INTHL7S(+$QS(INQ,7),0)),U) Q:$$INERS(4)
..S IN7M=$P($G(^INTHL7M(+$QS(INQ,8),0)),U) Q:$$INERS(5)
..S INJ=0 F S INJ=$O(IND(INJ)) Q:'INJ D
...S INDATA=IND(INJ) D INW(INJ=1)
K INSENS
Q
;
INERS(J) ;check for error, and if in error, log it.
; Input:
; INN = error to check for
; Output:
; Integer: 1=error found, 0=no error found
; Purpose: check for specific errors. e.g. J=2:check that INFLD has
; a numeric value, J=4:see if IN7S is nil.
;
N INQ
S INQ=$S(J=0:0,J=1:'INFIL,J=2:'INFLD,J=3:IN7F="",J=4:IN7S="",J=5:IN7M="",1:1),INERN=INERN+.001
S:INQ ^UTILITY("INHMGD",$J,"E",+IN7M,+IN7S,+IN7F)=+INFIL_U_+INFLD
Q INQ
;
INW(INTOP) ;Write the Data
; Inputs:
; INTOP = flag, 1 = check if new page needed
; INDATA = input print data
; Outputs:
; DUOUT = returns an exit request when user "^" out
; INDATA = reset to """ """
;
Q:$G(DUOUT)
S INTOP=$G(INTOP)
;
;check for room left on this page
I INTOP,(IOSL-$Y)<4 D PHEADER(1,.INHDR)
;
W !,?ING,@INDATA S INDATA="$C(32)"
Q
;
; Inputs:
; INLN = where to start printing the header array
; skips printing date & page# if you start at 2
; INHDR = header array
; INFLD = used in INHDR(4) - Field Number
; INFLDT = used in INHDR(4) - Field Name
; INFIL = used in INHDR(4) - File Number
; INFILT = used in INHDR(4) - File Name
; INPAGE = page number of last previous page
; Outputs:
; INPAGE = page number used on this page
;
N INK
I '$D(INHDR) D
.F INK=1:1:4 S INHDR(INK)=$G(INHDR(INK))
.S INHDR(10)="$$DASH^INHMGD1(IOM-3)"
;
;1st page need line 1 of the header
I 'INPAGE S INLN=1
;
;make sure there is room left on this page
I (IOSL-$Y)<(6-INLN) S INLN=1
;
;if we are printing line 1 of the header, it means we need a new page
;also, if we are interactive, wait at the end of the page
I INLN=1 S INPAGE=INPAGE+1 I INPAGE>1,$E(IOST)="C",'$D(IO("Q")) D
.I IO=IO(0) S DUOUT=$$CR^UTSRD
;
;need new page with new header?
I INLN=1 W @IOF N INK S INK=0 F S INK=$O(INHDR(INK)) Q:INK>10!'INK D
.W !,?ING,@INHDR(INK)
;
;just the header
I INLN'=1 N INK S INK=3 W ! F S INK=$O(INHDR(INK)) Q:INK>9!'INK D
.W !,?ING,@INHDR(INK)
Q
;
INHMGD8 ;CAR; 25 Apr 97 16:56;HL7 MESSAGING - PRINT SENSITIVITY ANALYSIS
+1 ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
+2 ;COPYRIGHT 1991-2000 SAIC
+3 ;
+4 ; MODULE NAME:
+5 ; HL7 Messaging - Print Sensitivity Analysis (INHMGD8).
+6 ;
+7 ; PURPOSE:
+8 ; Module INHMGD8 is used to print a Sensitivity Analysis
+9 ;
INSPRNT(INSENS,INALL) ;Print the data
+1 ;Print from an array of requested file,field pairs or print ALL
+2 ; e.g. INSENS(2,.03)="",INSENS(2,.04)="",...INSENS(8550,.01)=""
+3 ;Inputs:
+4 ; INSENS = 1 for Sensitivity Analysis (SA), 0 for no (SA)
+5 ; INSENS(n,m) = array of requested file,field pairs
+6 ; INALL = 1 for SA for ALL, 0 for not ALL
+7 ;
+8 NEW IN7F,IN7M,IN7S,IND,INDATAA,INQ,INFIL,INFILT,INFLD,INFLDT
+9 NEW INFSO,INHDR,INIOM2,INIOM3,INJ,INMAX,INWAIT,INH
+10 ;
+11 USE IO
+12 SET INDATA="$C(32)"
+13 ;
+14 ;setup some text constants
+15 SET INH(1)="HL7 Messaging Data Sources"
+16 SET INH(2)=" Sensitivity Analysis"
+17 SET INH(3)="-----Corresponding HL7: Message/Segment/Field Names"
+18 ;
+19 ;setup Data printing format, based on page width (IOM)
Begin DoDot:1
+20 ;------------------------------------------------------------
+21 ;set up for an 80 character line
IF IOM<96
Begin DoDot:2
+22 SET IND(1)="$E("" ""_IN7M,1,60)"
+23 SET IND(2)="$E("" ""_IN7S,1,42),?44,$E(IN7F,1,36)"
+24 ;S IND(3)="$C(32)"
End DoDot:2
QUIT
+25 ;------------------------------------------------------------
+26 ;set up for a 96 character line
IF IOM<132
Begin DoDot:2
+27 SET IND(1)="$E("" ""_IN7M,1,60)"
+28 SET IND(2)="$E("" ""_IN7S,1,45),?48,$E(IN7F,1,48)"
End DoDot:2
QUIT
+29 ;------------------------------------------------------------
+30 ;IOM is 132; set up for a 132 character line
+31 SET IND(1)="$E("" ""_IN7M,1,44),?46,$E(IN7S,1,42),?90,$E(IN7F,1,42)"
End DoDot:1
+32 ;
+33 ;setup header lines
+34 SET INHDR(1)="INH(1),INH(2),?(IOM-30),INDT,?(IOM-10),""PAGE: "",INPAGE"
+35 SET INHDR(2)="""Field#/Name"",?$S(IOM>96:IOM\3+2,IOM>80:IOM\2-3,1:IOM\2-3),""File Number/Name"""
+36 SET INHDR(3)="INH(3)_$$DASH^INHMGD1(IOM-54)"
+37 SET INHDR(4)="INFLD_"" "",?6,INFLDT,?$S(IOM>96:IOM\3,1:IOM\2-5),"" File: ""_$J(INFIL,7)_"" ""_INFILT"
+38 ;
+39 ;begin printing
+40 ;
+41 ;check for individual file,field SA
+42 IF $ORDER(INSENS(0))
IF 'INALL
Begin DoDot:1
+43 SET INFIL=0
FOR
SET INFIL=$ORDER(INSENS(INFIL))
IF 'INFIL!$GET(DUOUT)
QUIT
Begin DoDot:2
+44 SET INFLD=0
FOR
SET INFLD=$ORDER(INSENS(INFIL,INFLD))
IF 'INFLD!$GET(DUOUT)
QUIT
Begin DoDot:3
+45 SET INFILT=$PIECE($GET(^DIC(INFIL,0)),U)
+46 IF INFILT=""
SET INFILT=$PIECE($GET(^DD(INFIL,0)),U)
+47 SET INFLDT=$PIECE($GET(^DD(INFIL,INFLD,0)),U)
+48 DO PHEADER(4,.INHDR)
+49 SET INQ="^UTILITY(""INHMGD"","_$JOB_",""A"","_INFIL_","_INFLD_")"
+50 FOR
SET INQ=$QUERY(@INQ)
IF $QSUBSCRIPT(INQ,4)'=INFIL!($QSUBSCRIPT(INQ,5)'=INFLD)!$GET(DUOUT)
QUIT
Begin DoDot:4
+51 SET IN7F=$PIECE($GET(^INTHL7F(+$QSUBSCRIPT(INQ,6),0)),U)
IF $$INERS(3)
QUIT
+52 SET IN7S=$PIECE($GET(^INTHL7S(+$QSUBSCRIPT(INQ,7),0)),U)
IF $$INERS(4)
QUIT
+53 SET IN7M=$PIECE($GET(^INTHL7M(+$QSUBSCRIPT(INQ,8),0)),U)
IF $$INERS(5)
QUIT
+54 SET INJ=0
FOR
SET INJ=$ORDER(IND(INJ))
IF 'INJ
QUIT
Begin DoDot:5
+55 SET INDATA=IND(INJ)
DO INW(INJ=1)
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+56 ;
+57 ;check for SA on ALL file,field pairs
+58 IF INALL
Begin DoDot:1
+59 ;store the old sum (should change with new INFIL or INFLD)
SET INFSO=0
+60 SET INQ="^UTILITY(""INHMGD"","_$JOB_",""A"")"
+61 FOR
SET INQ=$QUERY(@INQ)
IF $QSUBSCRIPT(INQ,3)'["A"!$GET(DUOUT)
QUIT
Begin DoDot:2
+62 SET INFIL=$QSUBSCRIPT(INQ,4)
IF $$INERS(1)
QUIT
+63 SET INFLD=$QSUBSCRIPT(INQ,5)
IF $$INERS(2)
QUIT
+64 IF INFIL+INFLD'=INFSO
Begin DoDot:3
+65 SET INFILT=$PIECE($GET(^DIC(INFIL,0)),U)
+66 IF INFILT=""
SET INFILT=$PIECE($GET(^DD(INFIL,0)),U)
+67 SET INFLDT=$PIECE($GET(^DD(INFIL,INFLD,0)),U)
+68 DO PHEADER(4,.INHDR)
End DoDot:3
+69 SET INFSO=INFIL+INFLD
+70 SET IN7F=$PIECE($GET(^INTHL7F(+$QSUBSCRIPT(INQ,6),0)),U)
IF $$INERS(3)
QUIT
+71 SET IN7S=$PIECE($GET(^INTHL7S(+$QSUBSCRIPT(INQ,7),0)),U)
IF $$INERS(4)
QUIT
+72 SET IN7M=$PIECE($GET(^INTHL7M(+$QSUBSCRIPT(INQ,8),0)),U)
IF $$INERS(5)
QUIT
+73 SET INJ=0
FOR
SET INJ=$ORDER(IND(INJ))
IF 'INJ
QUIT
Begin DoDot:3
+74 SET INDATA=IND(INJ)
DO INW(INJ=1)
End DoDot:3
End DoDot:2
End DoDot:1
+75 KILL INSENS
+76 QUIT
+77 ;
INERS(J) ;check for error, and if in error, log it.
+1 ; Input:
+2 ; INN = error to check for
+3 ; Output:
+4 ; Integer: 1=error found, 0=no error found
+5 ; Purpose: check for specific errors. e.g. J=2:check that INFLD has
+6 ; a numeric value, J=4:see if IN7S is nil.
+7 ;
+8 NEW INQ
+9 SET INQ=$SELECT(J=0:0,J=1:'INFIL,J=2:'INFLD,J=3:IN7F="",J=4:IN7S="",J=5:IN7M="",1:1)
SET INERN=INERN+.001
+10 IF INQ
SET ^UTILITY("INHMGD",$JOB,"E",+IN7M,+IN7S,+IN7F)=+INFIL_U_+INFLD
+11 QUIT INQ
+12 ;
INW(INTOP) ;Write the Data
+1 ; Inputs:
+2 ; INTOP = flag, 1 = check if new page needed
+3 ; INDATA = input print data
+4 ; Outputs:
+5 ; DUOUT = returns an exit request when user "^" out
+6 ; INDATA = reset to """ """
+7 ;
+8 IF $GET(DUOUT)
QUIT
+9 SET INTOP=$GET(INTOP)
+10 ;
+11 ;check for room left on this page
+12 IF INTOP
IF (IOSL-$Y)<4
DO PHEADER(1,.INHDR)
+13 ;
+14 WRITE !,?ING,@INDATA
SET INDATA="$C(32)"
+15 QUIT
+16 ;
+1 ; Inputs:
+2 ; INLN = where to start printing the header array
+3 ; skips printing date & page# if you start at 2
+4 ; INHDR = header array
+5 ; INFLD = used in INHDR(4) - Field Number
+6 ; INFLDT = used in INHDR(4) - Field Name
+7 ; INFIL = used in INHDR(4) - File Number
+8 ; INFILT = used in INHDR(4) - File Name
+9 ; INPAGE = page number of last previous page
+10 ; Outputs:
+11 ; INPAGE = page number used on this page
+12 ;
+13 NEW INK
+14 IF '$DATA(INHDR)
Begin DoDot:1
+15 FOR INK=1:1:4
SET INHDR(INK)=$GET(INHDR(INK))
+16 SET INHDR(10)="$$DASH^INHMGD1(IOM-3)"
End DoDot:1
+17 ;
+18 ;1st page need line 1 of the header
+19 IF 'INPAGE
SET INLN=1
+20 ;
+21 ;make sure there is room left on this page
+22 IF (IOSL-$Y)<(6-INLN)
SET INLN=1
+23 ;
+24 ;if we are printing line 1 of the header, it means we need a new page
+25 ;also, if we are interactive, wait at the end of the page
+26 IF INLN=1
SET INPAGE=INPAGE+1
IF INPAGE>1
IF $EXTRACT(IOST)="C"
IF '$DATA(IO("Q"))
Begin DoDot:1
+27 IF IO=IO(0)
SET DUOUT=$$CR^UTSRD
End DoDot:1
+28 ;
+29 ;need new page with new header?
+30 IF INLN=1
WRITE @IOF
NEW INK
SET INK=0
FOR
SET INK=$ORDER(INHDR(INK))
IF INK>10!'INK
QUIT
Begin DoDot:1
+31 WRITE !,?ING,@INHDR(INK)
End DoDot:1
+32 ;
+33 ;just the header
+34 IF INLN'=1
NEW INK
SET INK=3
WRITE !
FOR
SET INK=$ORDER(INHDR(INK))
IF INK>9!'INK
QUIT
Begin DoDot:1
+35 WRITE !,?ING,@INHDR(INK)
End DoDot:1
+36 QUIT
+37 ;
