INHUTC3 ;bar; 22 May 97 12:08; API to error search and reporting functions
;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
;COPYRIGHT 1991-2000 SAIC
;;COPYRIGHT 1997 SAIC
Q
;
ARRAY(INDA,INA) ; update entry in criteria file with array of parms passed in
;
; input: INDA = ien of entry in 4001.1 file
; INA = Array of values to stuff into criteria fields.
; The value is the base name of the array rather than
; the array itself so it can be used with indirection.
; @INPARMS@("TTYPE",1)="DG REG"
; Refer to table under FIELDS tag for field mnemonics
;
N DIC,DIE,DA,DR,INX,INY,INFN
Q:'$G(INDA)!('$L($G(INA))) Q:'$D(^DIZ(4001.1,INDA,0)) Q:'$D(@INA)
; loop thru each field
S INX="" F S INX=$O(@INA@(INX)) Q:'$L(INX) D
. ; allow field numbers or mnemonics
. S INY=$S(INX:INX,1:$P($T(@INX),";",3))
. ; check if bad mnemonic
. I 'INY S @INA@(INX)=@INA@(INX)_"^invalid field mnemonic" Q
. ; is this a valid field?
. I '$D(^DD(4001.1,INY)) S @INA@(INX)=@INA@(INX)_"^field not defined" Q
. ; do not allow control fields except criteria name
. I INY<1,INY'=".04" S @INA@(INX)=@INA@(INX)_"^field update not allowed" Q
. ; handle multiples, check for subfile number
. S INFN=$P($G(^DD(4001.1,INY,0)),U,2) I INFN D Q
.. ; clear multiple unless flagged to append
.. I $G(@INA@(INX))'="A" K ^DIZ(4001.1,INDA,INY)
.. ; setup DIC call variables
.. N DIC,DO,DINUM,DA,X,Y,DR,INZ,DLAYGO
.. S DA(1)=INDA,DIC="^DIZ(4001.1,"_DA(1)_","_INY_",",DIC(0)="FL",DIC("P")=INFN,DLAYGO=+INFN
.. ; loop thru each multiple entry
.. S INZ=0 F S INZ=$O(@INA@(INX,INZ)) Q:INZ']"" D
... ;get value and check for NULL
... S X=@INA@(INX,INZ) Q:'$L(X)
... ; convert text to ien for pointer field
... I INFN["P" D Q
.... I X'=+X S X=+$$DIC^INHSYS05(U_$P($G(^DD(DLAYGO,.01,0)),U,3),X,"","F") Q:X<1
.... ; add value to multiple list
.... D ^DICN S:Y<1 @INA@(INX,INZ)=@INA@(INX,INZ)_"^invalid field value"
... ; add value to multiple list
... D ^DIC S:Y<1 @INA@(INX,INZ)=@INA@(INX,INZ)_"^invalid field value"
. ;
. ; add value to criteria field
. I $L(@INA@(INX)) S DIE=4001.1,DA=INDA,DR=INY_"///^S X="""_@INA@(INX)_"""" D ^DIE S:$G(Y)=-1 @INA@(INX)=@INA@(INX)_"^invalid field value"
Q
;
CVTCODE(X,FILE,FLD) ; make external from set of codes
; X = internal value FILE=file number FLD = field number
Q:'$L($G(X))!'$L($G(FILE))!'$L($G(FLD)) $G(X)
N %,C,S
S S=$G(^DD(FILE,FLD,0)) D:$P(S,U,2)["S"
. S C=";"_$P(S,U,3),%=$F(C,";"_X_":")
. S:% X=$P($E(C,%,999),";")
Q X
;
CVTDT(X) ; make external view of date
N T,H,M,S
; adjust time, only worried about END date
S T=$P(X,".",2),X=$P(X,"."),H=+$E(T,1,2),M=+$E(T,3,4),S=+$E(T,5,6)
I T D
. S:S>59 S=0,M=M+1 S:M>59 M=0,H=H+1 S:H>24 H=24,M=0,S=0
. S X=+(X_"."_$J(H,2)_$J(M,2)_$J(S,2))
S X=$$CDATASC^%ZTFDT(X,1,3)
Q X
;
FIELDS ; All tags below this are used as a field table for 4001.1 file
; field numbers less than 1 are control fields and cannot be passed in.
; The tag line is the mnemonic. The values in the line are:
;; field # ; field name ; INSRCH name
;;
;;.01;ENTRY;;
;;.02;USER WHO CREATED;USER;S X=$P($G(^DIC(3,+USER,0)),U)
;;.03;CONTROL
NAME ;;.04;CRITERIA NAME;NAME;
;;.05;CRITERIA TYPE;
;;.06;FUNCTION;
;;.07;BACKGROUND ID
;;.08;APPLICATION;
;;.09;LAST DATE ACCESSED
STARTDT ;;1;START DATE;INSTART;S X=$$CVTDT^INHUTC3(X+.0000001)
ENDDT ;;1.1;END DATE;INEND;S X=$$CVTDT^INHUTC3(X)
DEST1 ;;2;DESTINATION;INDEST;S Y=$P($G(^INRHD(X,0)),U) S:$L(Y) X=Y
STAT1 ;;3;STATUS;INSTAT;S X=$$CVTCODE^INHUTC3(X,4001.1,3)
MSGID ;;4;MESSAGE ID;INID
SOURCE ;;5;SOURCE;INSOURCE
DIRECT ;;6;DIRECTION;INDIR;S X=$$CVTCODE^INHUTC3(X,4001.1,6)
TTYPE1 ;;7;ORIGINATING TRANSACTION TYPE;INORIG;S Y=$P($G(^INRHT(X,0)),U) S:$L(Y) X=Y
PATIENT ;;8;PATIENT;INPAT;S Y=$P($G(^DPT(X,0)),U) S:$L(Y) X=Y
TEXT ;;9;SEARCH STRING;INTEXT;S X=INOPT("INSRCH","INTEXT",X)
MATCH ;;10;FIELD MATCH TYPE;INTYPE;S X=$$CVTCODE^INHUTC3(X,4001.1,10)
LISTORD ;;11;LISTING ORDER;INORDER;S X=$$CVTCODE^INHUTC3(X,4001.1,11)
EXPAND ;;12;EXPANDED DISPLAY;INEXPAND;S X=$$CVTCODE^INHUTC3(X,4001.1,12)
;;13.01;ACCEPT ACK TRANSACTION TYPE
;;13.02;TYPE OF TEST
;;13.03;CLIENT/SERVER
;;13.04;ACCEPT ACK CONDITION
;;13.05;STEP MODE
;;13.07;START AT PROCESS
;;14;TEST CASE DESCRIPTION
MSGSTDT ;;15.01;TRANS START DATE;INMSGSTART;S X=$$CVTDT^INHUTC3(X)
MSGENDT ;;15.02;TRANS END DATE;INMSGEND;S X=$$CVTDT^INHUTC3(X)
ERRLOC ;;15.03;ERROR LOCATIONS;INERLOC;S Y=$P($G(^INTHERL(X,0)),U) S:$L(Y) X=Y
ERRRES ;;15.04;ERROR RESOLUTION STATUS;INERSTAT;S X=$$CVTCODE^INHUTC3(X,4001.1,15.04)
;;16.01;IP ADDRESS
;;16.02;IP PORT
;;16.03;OPEN HANG TIME
;;16.04;OPEN RETRIES
;;16.05;TRANSMITTER HANG
;;16.06;SEND HANG TIME
;;16.07;SEND RETRIES
;;16.08;SEND TIMEOUT
;;16.09;READ HANG TIME
;;16.1;READ RETRIES
;;16.11;READ TIMEOUT
;;16.12;END OF LINE
;;17.01;CLIENT INIT STRING
;;17.02;INIT RESPONSE
;;17.03;SECURITY KEY FRAME
;;18.01;LOCAL HOST IP ADDRESS
;;18.02;LOCAL HOST IP PORT
;;18.03;LOGON SERVER
;;18.04;APP SERVER
;;18.05;SAVED TEST FILE NAME
;;19;UNIVERSAL INTERFACE TEST MSG
;;20;BACKGROUND PROCCESS
;;21;PAGE REPAINT FREQUENCY
;;21.01;PRE PROCESS
;;22;DETAILED REPORT
;;22.01;POST PROCESS
;;23;MAXIMUM NUMBER OF ITERATIONS
;;23.01;DESTINATION DETERMINATION
;;24;ALWAYS SCAN TO END OF QUEUE
RELSTDT ;;24.01;RELATIVE START DATE
RELENDT ;;24.02;RELATIVE END DATE
DIV1 ;;24.03;DIVISION;INDIV;S Y=$P($G(^DG(40.8,X,0)),U) S:$L(Y) X=Y
USER ;;24.04;USER NAME;INUSER;S Y=$P($G(^DIC(3,X,0)),U) S:$L(Y) X=Y
RMSGSTDT ;;24.05;REL AUX DATE 1
RMGSENDT ;;24.06;REL AUX DATE 2
;;25;MAXIMUM TIME COMPILING
;;26;NUMBER OF TRIES FOR AN ENTRY
;;27;INCLUDE FUTURE TASKS
DEVICE ;;28;DEVICE
;;29;GENERIC Y/N
;;30;GENERIC NUMBER
TTYPE ;;31;TRANSACTION TYPES;MULTIORIG;S Y=$P($G(^INRHT(X,0)),U) S:$L(Y) X=Y
DEST ;;32;DESTINATIONS;MULTIDEST;S Y=$P($G(^INRHD(X,0)),U) S:$L(Y) X=Y
STATUS ;;33;STATUSES;MULTISTAT;S X=$$CVTCODE^INHUTC3(X,4001.15,.01)
DIVISION ;;34;DIVISIONS;MULTIDIV;S Y=$P($G(^DG(40.8,X,0)),U) S:$L(Y) X=Y
INHUTC3 ;bar; 22 May 97 12:08; API to error search and reporting functions
+1 ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
+2 ;COPYRIGHT 1991-2000 SAIC
+3 ;;COPYRIGHT 1997 SAIC
+4 QUIT
+5 ;
ARRAY(INDA,INA) ; update entry in criteria file with array of parms passed in
+1 ;
+2 ; input: INDA = ien of entry in 4001.1 file
+3 ; INA = Array of values to stuff into criteria fields.
+4 ; The value is the base name of the array rather than
+5 ; the array itself so it can be used with indirection.
+6 ; @INPARMS@("TTYPE",1)="DG REG"
+7 ; Refer to table under FIELDS tag for field mnemonics
+8 ;
+9 NEW DIC,DIE,DA,DR,INX,INY,INFN
+10 IF '$GET(INDA)!('$LENGTH($GET(INA)))
QUIT
IF '$DATA(^DIZ(4001.1,INDA,0))
QUIT
IF '$DATA(@INA)
QUIT
+11 ; loop thru each field
+12 SET INX=""
FOR
SET INX=$ORDER(@INA@(INX))
IF '$LENGTH(INX)
QUIT
Begin DoDot:1
+13 ; allow field numbers or mnemonics
+14 SET INY=$SELECT(INX:INX,1:$PIECE($TEXT(@INX),";",3))
+15 ; check if bad mnemonic
+16 IF 'INY
SET @INA@(INX)=@INA@(INX)_"^invalid field mnemonic"
QUIT
+17 ; is this a valid field?
+18 IF '$DATA(^DD(4001.1,INY))
SET @INA@(INX)=@INA@(INX)_"^field not defined"
QUIT
+19 ; do not allow control fields except criteria name
+20 IF INY<1
IF INY'=".04"
SET @INA@(INX)=@INA@(INX)_"^field update not allowed"
QUIT
+21 ; handle multiples, check for subfile number
+22 SET INFN=$PIECE($GET(^DD(4001.1,INY,0)),U,2)
IF INFN
Begin DoDot:2
+23 ; clear multiple unless flagged to append
+24 IF $GET(@INA@(INX))'="A"
KILL ^DIZ(4001.1,INDA,INY)
+25 ; setup DIC call variables
+26 NEW DIC,DO,DINUM,DA,X,Y,DR,INZ,DLAYGO
+27 SET DA(1)=INDA
SET DIC="^DIZ(4001.1,"_DA(1)_","_INY_","
SET DIC(0)="FL"
SET DIC("P")=INFN
SET DLAYGO=+INFN
+28 ; loop thru each multiple entry
+29 SET INZ=0
FOR
SET INZ=$ORDER(@INA@(INX,INZ))
IF INZ']""
QUIT
Begin DoDot:3
+30 ;get value and check for NULL
+31 SET X=@INA@(INX,INZ)
IF '$LENGTH(X)
QUIT
+32 ; convert text to ien for pointer field
+33 IF INFN["P"
Begin DoDot:4
+34 IF X'=+X
SET X=+$$DIC^INHSYS05(U_$PIECE($GET(^DD(DLAYGO,.01,0)),U,3),X,"","F")
IF X<1
QUIT
+35 ; add value to multiple list
+36 DO ^DICN
IF Y<1
SET @INA@(INX,INZ)=@INA@(INX,INZ)_"^invalid field value"
End DoDot:4
QUIT
+37 ; add value to multiple list
+38 DO ^DIC
IF Y<1
SET @INA@(INX,INZ)=@INA@(INX,INZ)_"^invalid field value"
End DoDot:3
End DoDot:2
QUIT
+39 ;
+40 ; add value to criteria field
+41 IF $LENGTH(@INA@(INX))
SET DIE=4001.1
SET DA=INDA
SET DR=INY_"///^S X="""_@INA@(INX)_""""
DO ^DIE
IF $GET(Y)=-1
SET @INA@(INX)=@INA@(INX)_"^invalid field value"
End DoDot:1
+42 QUIT
+43 ;
CVTCODE(X,FILE,FLD) ; make external from set of codes
+1 ; X = internal value FILE=file number FLD = field number
+2 IF '$LENGTH($GET(X))!'$LENGTH($GET(FILE))!'$LENGTH($GET(FLD))
QUIT $GET(X)
+3 NEW %,C,S
+4 SET S=$GET(^DD(FILE,FLD,0))
IF $PIECE(S,U,2)["S"
Begin DoDot:1
+5 SET C=";"_$PIECE(S,U,3)
SET %=$FIND(C,";"_X_":")
+6 IF %
SET X=$PIECE($EXTRACT(C,%,999),";")
End DoDot:1
+7 QUIT X
+8 ;
CVTDT(X) ; make external view of date
+1 NEW T,H,M,S
+2 ; adjust time, only worried about END date
+3 SET T=$PIECE(X,".",2)
SET X=$PIECE(X,".")
SET H=+$EXTRACT(T,1,2)
SET M=+$EXTRACT(T,3,4)
SET S=+$EXTRACT(T,5,6)
+4 IF T
Begin DoDot:1
+5 IF S>59
SET S=0
SET M=M+1
IF M>59
SET M=0
SET H=H+1
IF H>24
SET H=24
SET M=0
SET S=0
+6 SET X=+(X_"."_$JUSTIFY(H,2)_$JUSTIFY(M,2)_$JUSTIFY(S,2))
End DoDot:1
+7 SET X=$$CDATASC^%ZTFDT(X,1,3)
+8 QUIT X
+9 ;
FIELDS ; All tags below this are used as a field table for 4001.1 file
+1 ; field numbers less than 1 are control fields and cannot be passed in.
+2 ; The tag line is the mnemonic. The values in the line are:
+3 ;; field # ; field name ; INSRCH name
+4 ;;
+5 ;;.01;ENTRY;;
+6 ;;.02;USER WHO CREATED;USER;S X=$P($G(^DIC(3,+USER,0)),U)
+7 ;;.03;CONTROL
NAME ;;.04;CRITERIA NAME;NAME;
+1 ;;.05;CRITERIA TYPE;
+2 ;;.06;FUNCTION;
+3 ;;.07;BACKGROUND ID
+4 ;;.08;APPLICATION;
+5 ;;.09;LAST DATE ACCESSED
STARTDT ;;1;START DATE;INSTART;S X=$$CVTDT^INHUTC3(X+.0000001)
ENDDT ;;1.1;END DATE;INEND;S X=$$CVTDT^INHUTC3(X)
DEST1 ;;2;DESTINATION;INDEST;S Y=$P($G(^INRHD(X,0)),U) S:$L(Y) X=Y
STAT1 ;;3;STATUS;INSTAT;S X=$$CVTCODE^INHUTC3(X,4001.1,3)
MSGID ;;4;MESSAGE ID;INID
SOURCE ;;5;SOURCE;INSOURCE
DIRECT ;;6;DIRECTION;INDIR;S X=$$CVTCODE^INHUTC3(X,4001.1,6)
TTYPE1 ;;7;ORIGINATING TRANSACTION TYPE;INORIG;S Y=$P($G(^INRHT(X,0)),U) S:$L(Y) X=Y
PATIENT ;;8;PATIENT;INPAT;S Y=$P($G(^DPT(X,0)),U) S:$L(Y) X=Y
TEXT ;;9;SEARCH STRING;INTEXT;S X=INOPT("INSRCH","INTEXT",X)
MATCH ;;10;FIELD MATCH TYPE;INTYPE;S X=$$CVTCODE^INHUTC3(X,4001.1,10)
LISTORD ;;11;LISTING ORDER;INORDER;S X=$$CVTCODE^INHUTC3(X,4001.1,11)
EXPAND ;;12;EXPANDED DISPLAY;INEXPAND;S X=$$CVTCODE^INHUTC3(X,4001.1,12)
+1 ;;13.01;ACCEPT ACK TRANSACTION TYPE
+2 ;;13.02;TYPE OF TEST
+3 ;;13.03;CLIENT/SERVER
+4 ;;13.04;ACCEPT ACK CONDITION
+5 ;;13.05;STEP MODE
+6 ;;13.07;START AT PROCESS
+7 ;;14;TEST CASE DESCRIPTION
MSGSTDT ;;15.01;TRANS START DATE;INMSGSTART;S X=$$CVTDT^INHUTC3(X)
MSGENDT ;;15.02;TRANS END DATE;INMSGEND;S X=$$CVTDT^INHUTC3(X)
ERRLOC ;;15.03;ERROR LOCATIONS;INERLOC;S Y=$P($G(^INTHERL(X,0)),U) S:$L(Y) X=Y
ERRRES ;;15.04;ERROR RESOLUTION STATUS;INERSTAT;S X=$$CVTCODE^INHUTC3(X,4001.1,15.04)
+1 ;;16.01;IP ADDRESS
+2 ;;16.02;IP PORT
+3 ;;16.03;OPEN HANG TIME
+4 ;;16.04;OPEN RETRIES
+5 ;;16.05;TRANSMITTER HANG
+6 ;;16.06;SEND HANG TIME
+7 ;;16.07;SEND RETRIES
+8 ;;16.08;SEND TIMEOUT
+9 ;;16.09;READ HANG TIME
+10 ;;16.1;READ RETRIES
+11 ;;16.11;READ TIMEOUT
+12 ;;16.12;END OF LINE
+13 ;;17.01;CLIENT INIT STRING
+14 ;;17.02;INIT RESPONSE
+15 ;;17.03;SECURITY KEY FRAME
+16 ;;18.01;LOCAL HOST IP ADDRESS
+17 ;;18.02;LOCAL HOST IP PORT
+18 ;;18.03;LOGON SERVER
+19 ;;18.04;APP SERVER
+20 ;;18.05;SAVED TEST FILE NAME
+21 ;;19;UNIVERSAL INTERFACE TEST MSG
+22 ;;20;BACKGROUND PROCCESS
+23 ;;21;PAGE REPAINT FREQUENCY
+24 ;;21.01;PRE PROCESS
+25 ;;22;DETAILED REPORT
+26 ;;22.01;POST PROCESS
+27 ;;23;MAXIMUM NUMBER OF ITERATIONS
+28 ;;23.01;DESTINATION DETERMINATION
+29 ;;24;ALWAYS SCAN TO END OF QUEUE
RELSTDT ;;24.01;RELATIVE START DATE
RELENDT ;;24.02;RELATIVE END DATE
DIV1 ;;24.03;DIVISION;INDIV;S Y=$P($G(^DG(40.8,X,0)),U) S:$L(Y) X=Y
USER ;;24.04;USER NAME;INUSER;S Y=$P($G(^DIC(3,X,0)),U) S:$L(Y) X=Y
RMSGSTDT ;;24.05;REL AUX DATE 1
RMGSENDT ;;24.06;REL AUX DATE 2
+1 ;;25;MAXIMUM TIME COMPILING
+2 ;;26;NUMBER OF TRIES FOR AN ENTRY
+3 ;;27;INCLUDE FUTURE TASKS
DEVICE ;;28;DEVICE
+1 ;;29;GENERIC Y/N
+2 ;;30;GENERIC NUMBER
TTYPE ;;31;TRANSACTION TYPES;MULTIORIG;S Y=$P($G(^INRHT(X,0)),U) S:$L(Y) X=Y
DEST ;;32;DESTINATIONS;MULTIDEST;S Y=$P($G(^INRHD(X,0)),U) S:$L(Y) X=Y
STATUS ;;33;STATUSES;MULTISTAT;S X=$$CVTCODE^INHUTC3(X,4001.15,.01)
DIVISION ;;34;DIVISIONS;MULTIDIV;S Y=$P($G(^DG(40.8,X,0)),U) S:$L(Y) X=Y
