INHUTC3.m

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