INTSUT3 ; cmi/flag/maw - JD 13 Apr 96 21:09 INTERACTIVE TESTING II ; [ 05/22/2002 2:54 PM ]
;;3.01;BHL IHS Interfaces with GIS;**1**;JUL 01, 2001
;COPYRIGHT 1991-2000 SAIC
;
Q
MERGE(INREQLST) ;Merge tests into ^UTILITY GLOBAL
; Input:
; INREQLST - Array of selected messages
;Get the next test run number
N INL,INT,TESTNUM
K ^UTILITY("INTHU",DUZ,$J)
S INL="" F S INL=$O(INREQLST(INL)) Q:INL="" D
.S INT=INREQLST(INL)
.M ^UTILITY("INTHU",DUZ,$J,INL,INT,0)=^INTHU(INT,0)
.M ^UTILITY("INTHU",DUZ,$J,INL,INT,3)=^INTHU(INT,3)
.S TESTNUM=$G(^UTILITY("INTHU",DUZ,$J))+1,^UTILITY("INTHU",DUZ,$J)=TESTNUM
Q
MERGE2(INARY) ;Merge tests into ^UTILITY GLOBAL
; Input:
; INARY - Array of selected messages
;Get the next test run number
N INL,INT,TESTNUM,INEXIST
S INEXIST=0
S:$G(INARY)="" INARY="^INTHU"
S INL="" F S INL=$O(INARY("A",INL)) Q:INL="" D
.S INT=INARY("A",INL)
.S:$D(^UTILITY("INTHU",DUZ,$J,INL)) INEXIST=1
.K ^UTILITY("INTHU",DUZ,$J,INL)
.M ^UTILITY("INTHU",DUZ,$J,INL,INT,0)=@(INARY_"(INT,0)")
.M ^UTILITY("INTHU",DUZ,$J,INL,INT,3)=@(INARY_"(INT,3)")
.I 'INEXIST S TESTNUM=$G(^UTILITY("INTHU",DUZ,$J))+1,^UTILITY("INTHU",DUZ,$J)=TESTNUM
Q
UPDAT2FL(INREQLST,INDA) ;Merge to 4001.1 multiple
; Input:
; INREQLST - Array of selected messages
; INDA - ien of 4001.1
;Get the next test run number
N INL,INT,TESTNUM
K ^DIZ(4001.1,INDA,19,0)
S TESTNUM=""
S INL="" F S INL=$O(INREQLST(INL)) Q:INL="" D
.S INT=INREQLST(INL)
.I $D(^INTHU(INT,0)) D
..S ^DIZ(4001.1,INDA,19,0)=INT_U_$P(^INTHU(INT,0),U,5)
..S TESTNUM=TESTNUM+1
S ^DIZ(4001.1,INDA,19,0)="^4001.19PA^"_TESTNUM_U_TESTNUM
Q
UPDTFRUT(INDA) ;Update ^UTILITY to 4001.1 multiple
; Input:
; ^UTILITY("DIS",$J - selected messages
; INDA - ien of 4001.1
; Output:
; ^DIZ(4001.1,INDA,19, multiple
;
N INL,INT,TESTNUM
K ^DIZ(4001.1,INDA,19,0)
S TESTNUM=""
S INL="" F S INL=$O(^UTILITY("INTHU",DUZ,$J,INL)) Q:INL="" D
.S INT=$O(^UTILITY("INTHU",DUZ,$J,INL,""))
.I $D(^INTHU(INT,0)) D
..D UPSINGMS^INTSUT3(INDA,"LS",INT)
Q
UPDATE(INDA) ;Update INREQLST with test messages
; Input/Output - INREQLST - Name of Utility with tests
N INL,INT,IND
K ^UTILITY("DIS",$J)
S INL=0,INT="" F S INT=$O(^DIZ(4001.1,INDA,19,INT)) Q:INT="" D
.S IND=+$G(^DIZ(4001.1,INDA,19,INT,0))
.I IND D
..S INL=INL+1
..M ^UTILITY("DIS",$J,INL,IND,0)=^INTHU(IND,0)
..S ^UTILITY("DIS",$J)=INL
Q
UPSINGMS(INDA,IN0,INENT) ;Update a single entry in test message multiple
; Input:
; INDA - ien of Test Criteria
; IN0 - DIC(0)
; INENT - value to stuff
N DLAYGO,DA,DIE,DIC,X,Y
K DIC S DLAYGO="4001.1",DIC("P")=$P(^DD(4001.1,19,0),U,2)
S DIC="^DIZ(4001.1,"_INDA_",19,",DIC(0)=IN0,DA(1)=INDA,DIE=DIC
S X=INENT
D ^DICN
I Y<0 D DISPLAY^INTSUT1("Unable to update Test Message multiple - "_INENT) Q
Q
UPDTSND(INDA) ;Update ^UTILITY("INTHU" with test messages
; Input - INDA - ien of Criteria
; Output - ^UTILITY - Name of Utility with tests
N INL,INT,IND
K ^UTILITY("INTHU",DUZ,$J)
S INL=0,INT="" F S INT=$O(^DIZ(4001.1,INDA,19,INT)) Q:INT="" D
.S IND=+$G(^DIZ(4001.1,INDA,19,INT,0))
.I IND D
..S INL=INL+1
..M ^UTILITY("INTHU",DUZ,$J,INL,IND,0)=^INTHU(IND,0)
..M ^UTILITY("INTHU",DUZ,$J,INL,IND,3)=^INTHU(IND,3)
..S ^UTILITY("INTHU",$J)=INL
..;kill activity log from UIF
..K ^INTHU(IND,1)
Q
FLATNAM(INAME,INTYP) ;Get VMS flat file name
;Input:
; INAME - default name
; INTYP - "S" - save file
; Returns: INAME - VMS Flat file name
N DONE S DONE=0
I $G(INTYP)="S" S INTYP="Save to"
E S INTYP="Restore from"
F D Q:DONE
.W @IOF,!!
.S INAME=$$READ^%ZTF(1,30,"Enter the VMS flat file to "_INTYP_": ",INAME)
.I INAME="^" S INAME=""
.I INAME="" S DONE=1 Q
.I INAME["?" D Q
..N $ET
..S $ZE="",$ZT="ERR^INTSUT3"
..S INAME=""
..;I INTYP="Save to" W !,"Enter a flat file name to save Criteria to"
..;E W $ZC(%SPAWN,"DIR")
..I $$CR^UTSRD
.S DONE=1
Q INAME
EXISTS(INODE0,INAME) ;Check to see if user defined record exists
;Input:
; INODE0 - 0 node of flat saved utility global or 4001.1 0 node
;Output:
; INAME - Name of criteria
;Returns: 0 if does not exist, or ien of existing criteria
;
N INOPT2,INCTRL
S INCTRL=$S('$L($G(INCTRL)):"U","SUBW"[INCTRL:INCTRL,1:"U")
; quit if not to be saved
S INAME=$P(INODE0,U,4)
Q:'$L(INAME) ""
; see if name exists already
S INOPT2("DUZ")=DUZ,INOPT2("TYPE")=$P(INODE0,U,5),INOPT2("APP")=$P(INODE0,U,8),INOPT2("FUNC")=$P(INODE0,U,6),INOPT2("CONTROL")=INCTRL
Q $$LOOKUP^INHUTC1(.INOPT2,INAME)
ERR Q
INTSUT3 ; cmi/flag/maw - JD 13 Apr 96 21:09 INTERACTIVE TESTING II ; [ 05/22/2002 2:54 PM ]
+1 ;;3.01;BHL IHS Interfaces with GIS;**1**;JUL 01, 2001
+2 ;COPYRIGHT 1991-2000 SAIC
+3 ;
+4 QUIT
MERGE(INREQLST) ;Merge tests into ^UTILITY GLOBAL
+1 ; Input:
+2 ; INREQLST - Array of selected messages
+3 ;Get the next test run number
+4 NEW INL,INT,TESTNUM
+5 KILL ^UTILITY("INTHU",DUZ,$JOB)
+6 SET INL=""
FOR
SET INL=$ORDER(INREQLST(INL))
IF INL=""
QUIT
Begin DoDot:1
+7 SET INT=INREQLST(INL)
+8 MERGE ^UTILITY("INTHU",DUZ,$JOB,INL,INT,0)=^INTHU(INT,0)
+9 MERGE ^UTILITY("INTHU",DUZ,$JOB,INL,INT,3)=^INTHU(INT,3)
+10 SET TESTNUM=$GET(^UTILITY("INTHU",DUZ,$JOB))+1
SET ^UTILITY("INTHU",DUZ,$JOB)=TESTNUM
End DoDot:1
+11 QUIT
MERGE2(INARY) ;Merge tests into ^UTILITY GLOBAL
+1 ; Input:
+2 ; INARY - Array of selected messages
+3 ;Get the next test run number
+4 NEW INL,INT,TESTNUM,INEXIST
+5 SET INEXIST=0
+6 IF $GET(INARY)=""
SET INARY="^INTHU"
+7 SET INL=""
FOR
SET INL=$ORDER(INARY("A",INL))
IF INL=""
QUIT
Begin DoDot:1
+8 SET INT=INARY("A",INL)
+9 IF $DATA(^UTILITY("INTHU",DUZ,$JOB,INL))
SET INEXIST=1
+10 KILL ^UTILITY("INTHU",DUZ,$JOB,INL)
+11 MERGE ^UTILITY("INTHU",DUZ,$JOB,INL,INT,0)=@(INARY_"(INT,0)")
+12 MERGE ^UTILITY("INTHU",DUZ,$JOB,INL,INT,3)=@(INARY_"(INT,3)")
+13 IF 'INEXIST
SET TESTNUM=$GET(^UTILITY("INTHU",DUZ,$JOB))+1
SET ^UTILITY("INTHU",DUZ,$JOB)=TESTNUM
End DoDot:1
+14 QUIT
UPDAT2FL(INREQLST,INDA) ;Merge to 4001.1 multiple
+1 ; Input:
+2 ; INREQLST - Array of selected messages
+3 ; INDA - ien of 4001.1
+4 ;Get the next test run number
+5 NEW INL,INT,TESTNUM
+6 KILL ^DIZ(4001.1,INDA,19,0)
+7 SET TESTNUM=""
+8 SET INL=""
FOR
SET INL=$ORDER(INREQLST(INL))
IF INL=""
QUIT
Begin DoDot:1
+9 SET INT=INREQLST(INL)
+10 IF $DATA(^INTHU(INT,0))
Begin DoDot:2
+11 SET ^DIZ(4001.1,INDA,19,0)=INT_U_$PIECE(^INTHU(INT,0),U,5)
+12 SET TESTNUM=TESTNUM+1
End DoDot:2
End DoDot:1
+13 SET ^DIZ(4001.1,INDA,19,0)="^4001.19PA^"_TESTNUM_U_TESTNUM
+14 QUIT
UPDTFRUT(INDA) ;Update ^UTILITY to 4001.1 multiple
+1 ; Input:
+2 ; ^UTILITY("DIS",$J - selected messages
+3 ; INDA - ien of 4001.1
+4 ; Output:
+5 ; ^DIZ(4001.1,INDA,19, multiple
+6 ;
+7 NEW INL,INT,TESTNUM
+8 KILL ^DIZ(4001.1,INDA,19,0)
+9 SET TESTNUM=""
+10 SET INL=""
FOR
SET INL=$ORDER(^UTILITY("INTHU",DUZ,$JOB,INL))
IF INL=""
QUIT
Begin DoDot:1
+11 SET INT=$ORDER(^UTILITY("INTHU",DUZ,$JOB,INL,""))
+12 IF $DATA(^INTHU(INT,0))
Begin DoDot:2
+13 DO UPSINGMS^INTSUT3(INDA,"LS",INT)
End DoDot:2
End DoDot:1
+14 QUIT
UPDATE(INDA) ;Update INREQLST with test messages
+1 ; Input/Output - INREQLST - Name of Utility with tests
+2 NEW INL,INT,IND
+3 KILL ^UTILITY("DIS",$JOB)
+4 SET INL=0
SET INT=""
FOR
SET INT=$ORDER(^DIZ(4001.1,INDA,19,INT))
IF INT=""
QUIT
Begin DoDot:1
+5 SET IND=+$GET(^DIZ(4001.1,INDA,19,INT,0))
+6 IF IND
Begin DoDot:2
+7 SET INL=INL+1
+8 MERGE ^UTILITY("DIS",$JOB,INL,IND,0)=^INTHU(IND,0)
+9 SET ^UTILITY("DIS",$JOB)=INL
End DoDot:2
End DoDot:1
+10 QUIT
UPSINGMS(INDA,IN0,INENT) ;Update a single entry in test message multiple
+1 ; Input:
+2 ; INDA - ien of Test Criteria
+3 ; IN0 - DIC(0)
+4 ; INENT - value to stuff
+5 NEW DLAYGO,DA,DIE,DIC,X,Y
+6 KILL DIC
SET DLAYGO="4001.1"
SET DIC("P")=$PIECE(^DD(4001.1,19,0),U,2)
+7 SET DIC="^DIZ(4001.1,"_INDA_",19,"
SET DIC(0)=IN0
SET DA(1)=INDA
SET DIE=DIC
+8 SET X=INENT
+9 DO ^DICN
+10 IF Y<0
DO DISPLAY^INTSUT1("Unable to update Test Message multiple - "_INENT)
QUIT
+11 QUIT
UPDTSND(INDA) ;Update ^UTILITY("INTHU" with test messages
+1 ; Input - INDA - ien of Criteria
+2 ; Output - ^UTILITY - Name of Utility with tests
+3 NEW INL,INT,IND
+4 KILL ^UTILITY("INTHU",DUZ,$JOB)
+5 SET INL=0
SET INT=""
FOR
SET INT=$ORDER(^DIZ(4001.1,INDA,19,INT))
IF INT=""
QUIT
Begin DoDot:1
+6 SET IND=+$GET(^DIZ(4001.1,INDA,19,INT,0))
+7 IF IND
Begin DoDot:2
+8 SET INL=INL+1
+9 MERGE ^UTILITY("INTHU",DUZ,$JOB,INL,IND,0)=^INTHU(IND,0)
+10 MERGE ^UTILITY("INTHU",DUZ,$JOB,INL,IND,3)=^INTHU(IND,3)
+11 SET ^UTILITY("INTHU",$JOB)=INL
+12 ;kill activity log from UIF
+13 KILL ^INTHU(IND,1)
End DoDot:2
End DoDot:1
+14 QUIT
FLATNAM(INAME,INTYP) ;Get VMS flat file name
+1 ;Input:
+2 ; INAME - default name
+3 ; INTYP - "S" - save file
+4 ; Returns: INAME - VMS Flat file name
+5 NEW DONE
SET DONE=0
+6 IF $GET(INTYP)="S"
SET INTYP="Save to"
+7 IF '$TEST
SET INTYP="Restore from"
+8 FOR
Begin DoDot:1
+9 WRITE @IOF,!!
+10 SET INAME=$$READ^%ZTF(1,30,"Enter the VMS flat file to "_INTYP_": ",INAME)
+11 IF INAME="^"
SET INAME=""
+12 IF INAME=""
SET DONE=1
QUIT
+13 IF INAME["?"
Begin DoDot:2
+14 NEW $ETRAP
+15 SET $ZE=""
SET $ZT="ERR^INTSUT3"
+16 SET INAME=""
+17 ;I INTYP="Save to" W !,"Enter a flat file name to save Criteria to"
+18 ;E W $ZC(%SPAWN,"DIR")
+19 IF $$CR^UTSRD
End DoDot:2
QUIT
+20 SET DONE=1
End DoDot:1
IF DONE
QUIT
+21 QUIT INAME
EXISTS(INODE0,INAME) ;Check to see if user defined record exists
+1 ;Input:
+2 ; INODE0 - 0 node of flat saved utility global or 4001.1 0 node
+3 ;Output:
+4 ; INAME - Name of criteria
+5 ;Returns: 0 if does not exist, or ien of existing criteria
+6 ;
+7 NEW INOPT2,INCTRL
+8 SET INCTRL=$SELECT('$LENGTH($GET(INCTRL)):"U","SUBW"[INCTRL:INCTRL,1:"U")
+9 ; quit if not to be saved
+10 SET INAME=$PIECE(INODE0,U,4)
+11 IF '$LENGTH(INAME)
QUIT ""
+12 ; see if name exists already
+13 SET INOPT2("DUZ")=DUZ
SET INOPT2("TYPE")=$PIECE(INODE0,U,5)
SET INOPT2("APP")=$PIECE(INODE0,U,8)
SET INOPT2("FUNC")=$PIECE(INODE0,U,6)
SET INOPT2("CONTROL")=INCTRL
+14 QUIT $$LOOKUP^INHUTC1(.INOPT2,INAME)
ERR QUIT
