- 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 ;
