INHES1 ;Utilities; 1 Feb 96 08:44
;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
;COPYRIGHT 1991-2000 SAIC
;
;
LIST(INSRCH,DWLRF,INL) ; Build the error array
;
; Module Name: LIST ( Build the list of matching errors )
;
; Description:
; Loop through the errors from date-start to date-end and stores
; the IEN of matching with error message in INL array.
;
; Return: None
;
; Parameters:
; INSRCH(PBR) = Array for holding search criteria information
; DWLRF(PBV) = Settings for the Display Processor
; INL(PBR) = Array used to load with error items matching the criteria
; Code begins
N INM,INFNDCT,IND
; Initialize errors count, start date, and search direction
S INFNDCT=0
S:'$D(INSRCH("INORDER")) INSRCH("INORDER")=1
S IND=$S('INSRCH("INORDER"):INSRCH("INEND"),1:INSRCH("INSTART"))
S INRVSRCH=$S('INSRCH("INORDER"):-1,1:1)
; Loop through ^INTHER from start date to end date
F Q:$S('IND:1,(INRVSRCH>-1)&(IND>INSRCH("INEND")):1,(INRVSRCH=-1)&(IND<INSRCH("INSTART")):1,1:0) D S IND=$O(^INTHER("B",IND),INRVSRCH)
.; call MSGTEST to find error matching user select criteria
. S INM="" F S INM=$O(^INTHER("B",IND,INM),INRVSRCH) Q:'INM D MSGTEST(INM,.DWLRF,.INSRCH,.INFNDCT)
; count of error messages found matching criteria
S INSRCH("FOUND")=$G(INFNDCT)
Q
;
MSGTEST(INEIEN,INLIST,INSRCH,INFNDCT) ; Add matching error to array
;
; Description: MSGTEST (Interface Error Match Criteria Test). Tests
; the error for matches to values passed in INSRCH
; array and save the IEN to the INLIST array.
;
; Return = None
; Parameters:
; INEIEN(PBV)= IEN into ^INTHER
; INLIST(PBR) = The NAME of the array to add items found
; INSRCH(PBR) = The array of items to find
; INFNDCT(PBR) = The count of errors found
;
; Code begins
N INTEMPX,INTEMPY,INMAXSZ,INMIEN
S INMAXSZ=120,INTEMPX=$G(^INTHER(INEIEN,0))
S INMIEN=$P(INTEMPX,U,4),INTEMPY=$G(^INTHU(+INMIEN,0))
; Checking the Interface Error file
I INSRCH("INDEST")]"" I $P(INTEMPX,U,9)'=INSRCH("INDEST")&($P(INTEMPY,U,2)'=INSRCH("INDEST")) Q
I INSRCH("INORIG")]"" I $P(INTEMPX,U,2)'=INSRCH("INORIG")&($P(INTEMPY,U,11)'=INSRCH("INORIG")) Q
I $D(INSRCH("INERLOC")),INSRCH("INERLOC")]"",$P(INTEMPX,U,5)'=INSRCH("INERLOC") Q
I $D(INSRCH("INERSTAT")),INSRCH("INERSTAT")]"",$P(INTEMPX,U,10)'=INSRCH("INERSTAT") Q
I $D(INSRCH("INTEXT"))>9 Q:'$$INERSRCH^INHERR1(.INSRCH,INEIEN,INSRCH("INTYPE"))
; Checking the Interface Message file
I $G(INSRCH("INMSGSTART")) Q:($P(INTEMPY,U)<INSRCH("INMSGSTART"))
I $G(INSRCH("INMSGSTART")) Q:($P(INTEMPY,U)>INSRCH("INMSGEND"))
I INSRCH("INID")]"" Q:$P(INTEMPY,U,5)'=INSRCH("INID")
I INSRCH("INDIR")]"" Q:$P(INTEMPY,U,10)'=INSRCH("INDIR")
I INSRCH("INSTAT")]"" Q:$P(INTEMPY,U,3)'=INSRCH("INSTAT")
I INSRCH("INSOURCE")]"" Q:$E($P(INTEMPY,U,8),1,$L(INSRCH("INSOURCE")))'=INSRCH("INSOURCE")
I INSRCH("INPAT")]"" Q:'INMIEN Q:'$$INMSPAT^INHMS1(INMIEN,INSRCH("INPAT"))
; move the found-items array to ^UTILITY if it's getting too large
; kill the new ^UTILITY space incase it already exists prior to merg
I INFNDCT>INMAXSZ,(INLIST'[U) N INTEMPY S INTEMPY=INLIST,INLIST="^UTILITY($J,""INL"")" K @INLIST M @INLIST=@INTEMPY K @INTEMPY,INTEMPY
; Save the IEN of the error found and update count
S INFNDCT=INFNDCT+1,@INLIST@(INFNDCT)=INEIEN
Q
;
CRIHDR(INSRCH) ; Display the criteria header
; Reuse code from the INHERR
;
; Description: The CRIHDR is used to display the input criteria
; in header.
;
;
; Return: None
; Parameter:
; INSRCH = Array contains search criteria
;
;*** Interface Error File
; display Destination
I INSRCH("INDEST")]"" S C=$P(^DD(4001.1,2,0),U,2),Y=INSRCH("INDEST") D Y^DIQ W !,"DESTINATION",?30," : ",Y
; display Original Transaction Type
I INSRCH("INORIG")]"" S C=$P(^DD(4001.1,7,0),U,2),Y=INSRCH("INORIG") D Y^DIQ W !,"ORIGINAL TRANSACTION TYPE",?30," : ",Y
; display Error location
I $G(INSRCH("INERLOC")) S C=$P(^DD(4001.1,15.03,0),U,2),Y=INSRCH("INERLOC") D Y^DIQ W !,"ERROR LOCATION",?30," : ",Y
; display Error Resolution Status
I $G(INSRCH("INERSTAT")) D CODETBL^INHERR3("ERSTAT",4001.1,15.04) W !,"ERROR RESOLUTION STATUS",?30," : ",ERSTAT(INSRCH("INERSTAT"))
I $D(INSRCH("INTEXT"))>9 D
.W !,"TEXT MATCH",?30," : "
.S INT=0 F S INT=$O(INSRCH("INTEXT",INT)) Q:'INT D
.. W ?34,$G(INSRCH("INTEXT",INT)),!
.D CODETBL^INHERR3("MTYPE",4001.1,10)
.W !,"Match type",?30," : ",MTYPE(INSRCH("INTYPE"))
;*** Interface message file
; display message start date
I INSRCH("INMSGSTART")]"" S Y=INSRCH("INMSGSTART")+.000001,Y=$J(Y,12,4) D DD^%DT W !,"MESSAGE START DATE",?30," : ",Y
; display message end date
I INSRCH("INMSGEND")]"" S Y=INSRCH("INMSGEND")-.000001,Y=$J(Y,12,4) D DD^%DT W !,"MESSAGE END DATE",?30," : ",Y
; display Message ID
I INSRCH("INID")]"" W !,"MESSAGE ID",?30," : ",$G(INSRCH("INID"))
; display direction
I INSRCH("INDIR")]"" S C=$P(^DD(4001.1,6,0),U,2),Y=INSRCH("INDIR") D Y^DIQ W !,"DIRECTION",?30," : ",Y
; display Status
I INSRCH("INSTAT")]"" D CODETBL^INHERR3("STAT",4001.1,3) W !,"STATUS",?30," : ",STAT(INSRCH("INSTAT"))
; display Source
I INSRCH("INSOURCE")]"" W !,"SOURCE",?30," : ",$G(INSRCH("INSOURCE"))
; display Patient
I INSRCH("INPAT")]"" S C=$P(^DD(4001.1,8,0),U,2),Y=$G(INSRCH("INPAT")) D Y^DIQ W !,"PATIENT",?30," : ",Y
I $D(INSRCH("TEXTLEN")) W !,"EXTRACT TEXT LENGTH",?30," : ",INSRCH("TEXTLEN") W:INSRCH("TEXTLEN")>120 !?5,"NOTE : ACTUAL TEXT LENGTH MUST NOT EXCEED 120"
W !
Q
INHES1 ;Utilities; 1 Feb 96 08:44
+1 ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
+2 ;COPYRIGHT 1991-2000 SAIC
+3 ;
+4 ;
LIST(INSRCH,DWLRF,INL) ; Build the error array
+1 ;
+2 ; Module Name: LIST ( Build the list of matching errors )
+3 ;
+4 ; Description:
+5 ; Loop through the errors from date-start to date-end and stores
+6 ; the IEN of matching with error message in INL array.
+7 ;
+8 ; Return: None
+9 ;
+10 ; Parameters:
+11 ; INSRCH(PBR) = Array for holding search criteria information
+12 ; DWLRF(PBV) = Settings for the Display Processor
+13 ; INL(PBR) = Array used to load with error items matching the criteria
+14 ; Code begins
+15 NEW INM,INFNDCT,IND
+16 ; Initialize errors count, start date, and search direction
+17 SET INFNDCT=0
+18 IF '$DATA(INSRCH("INORDER"))
SET INSRCH("INORDER")=1
+19 SET IND=$SELECT('INSRCH("INORDER"):INSRCH("INEND"),1:INSRCH("INSTART"))
+20 SET INRVSRCH=$SELECT('INSRCH("INORDER"):-1,1:1)
+21 ; Loop through ^INTHER from start date to end date
+22 FOR
IF $SELECT('IND
QUIT
Begin DoDot:1
+23 ; call MSGTEST to find error matching user select criteria
+24 SET INM=""
FOR
SET INM=$ORDER(^INTHER("B",IND,INM),INRVSRCH)
IF 'INM
QUIT
DO MSGTEST(INM,.DWLRF,.INSRCH,.INFNDCT)
End DoDot:1
SET IND=$ORDER(^INTHER("B",IND),INRVSRCH)
+25 ; count of error messages found matching criteria
+26 SET INSRCH("FOUND")=$GET(INFNDCT)
+27 QUIT
+28 ;
MSGTEST(INEIEN,INLIST,INSRCH,INFNDCT) ; Add matching error to array
+1 ;
+2 ; Description: MSGTEST (Interface Error Match Criteria Test). Tests
+3 ; the error for matches to values passed in INSRCH
+4 ; array and save the IEN to the INLIST array.
+5 ;
+6 ; Return = None
+7 ; Parameters:
+8 ; INEIEN(PBV)= IEN into ^INTHER
+9 ; INLIST(PBR) = The NAME of the array to add items found
+10 ; INSRCH(PBR) = The array of items to find
+11 ; INFNDCT(PBR) = The count of errors found
+12 ;
+13 ; Code begins
+14 NEW INTEMPX,INTEMPY,INMAXSZ,INMIEN
+15 SET INMAXSZ=120
SET INTEMPX=$GET(^INTHER(INEIEN,0))
+16 SET INMIEN=$PIECE(INTEMPX,U,4)
SET INTEMPY=$GET(^INTHU(+INMIEN,0))
+17 ; Checking the Interface Error file
+18 IF INSRCH("INDEST")]""
IF $PIECE(INTEMPX,U,9)'=INSRCH("INDEST")&($PIECE(INTEMPY,U,2)'=INSRCH("INDEST"))
QUIT
+19 IF INSRCH("INORIG")]""
IF $PIECE(INTEMPX,U,2)'=INSRCH("INORIG")&($PIECE(INTEMPY,U,11)'=INSRCH("INORIG"))
QUIT
+20 IF $DATA(INSRCH("INERLOC"))
IF INSRCH("INERLOC")]""
IF $PIECE(INTEMPX,U,5)'=INSRCH("INERLOC")
QUIT
+21 IF $DATA(INSRCH("INERSTAT"))
IF INSRCH("INERSTAT")]""
IF $PIECE(INTEMPX,U,10)'=INSRCH("INERSTAT")
QUIT
+22 IF $DATA(INSRCH("INTEXT"))>9
IF '$$INERSRCH^INHERR1(.INSRCH,INEIEN,INSRCH("INTYPE"))
QUIT
+23 ; Checking the Interface Message file
+24 IF $GET(INSRCH("INMSGSTART"))
IF ($PIECE(INTEMPY,U)<INSRCH("INMSGSTART"))
QUIT
+25 IF $GET(INSRCH("INMSGSTART"))
IF ($PIECE(INTEMPY,U)>INSRCH("INMSGEND"))
QUIT
+26 IF INSRCH("INID")]""
IF $PIECE(INTEMPY,U,5)'=INSRCH("INID")
QUIT
+27 IF INSRCH("INDIR")]""
IF $PIECE(INTEMPY,U,10)'=INSRCH("INDIR")
QUIT
+28 IF INSRCH("INSTAT")]""
IF $PIECE(INTEMPY,U,3)'=INSRCH("INSTAT")
QUIT
+29 IF INSRCH("INSOURCE")]""
IF $EXTRACT($PIECE(INTEMPY,U,8),1,$LENGTH(INSRCH("INSOURCE")))'=INSRCH("INSOURCE")
QUIT
+30 IF INSRCH("INPAT")]""
IF 'INMIEN
QUIT
IF '$$INMSPAT^INHMS1(INMIEN,INSRCH("INPAT"))
QUIT
+31 ; move the found-items array to ^UTILITY if it's getting too large
+32 ; kill the new ^UTILITY space incase it already exists prior to merg
+33 IF INFNDCT>INMAXSZ
IF (INLIST'[U)
NEW INTEMPY
SET INTEMPY=INLIST
SET INLIST="^UTILITY($J,""INL"")"
KILL @INLIST
MERGE @INLIST=@INTEMPY
KILL @INTEMPY,INTEMPY
+34 ; Save the IEN of the error found and update count
+35 SET INFNDCT=INFNDCT+1
SET @INLIST@(INFNDCT)=INEIEN
+36 QUIT
+37 ;
CRIHDR(INSRCH) ; Display the criteria header
+1 ; Reuse code from the INHERR
+2 ;
+3 ; Description: The CRIHDR is used to display the input criteria
+4 ; in header.
+5 ;
+6 ;
+7 ; Return: None
+8 ; Parameter:
+9 ; INSRCH = Array contains search criteria
+10 ;
+11 ;*** Interface Error File
+12 ; display Destination
+13 IF INSRCH("INDEST")]""
SET C=$PIECE(^DD(4001.1,2,0),U,2)
SET Y=INSRCH("INDEST")
DO Y^DIQ
WRITE !,"DESTINATION",?30," : ",Y
+14 ; display Original Transaction Type
+15 IF INSRCH("INORIG")]""
SET C=$PIECE(^DD(4001.1,7,0),U,2)
SET Y=INSRCH("INORIG")
DO Y^DIQ
WRITE !,"ORIGINAL TRANSACTION TYPE",?30," : ",Y
+16 ; display Error location
+17 IF $GET(INSRCH("INERLOC"))
SET C=$PIECE(^DD(4001.1,15.03,0),U,2)
SET Y=INSRCH("INERLOC")
DO Y^DIQ
WRITE !,"ERROR LOCATION",?30," : ",Y
+18 ; display Error Resolution Status
+19 IF $GET(INSRCH("INERSTAT"))
DO CODETBL^INHERR3("ERSTAT",4001.1,15.04)
WRITE !,"ERROR RESOLUTION STATUS",?30," : ",ERSTAT(INSRCH("INERSTAT"))
+20 IF $DATA(INSRCH("INTEXT"))>9
Begin DoDot:1
+21 WRITE !,"TEXT MATCH",?30," : "
+22 SET INT=0
FOR
SET INT=$ORDER(INSRCH("INTEXT",INT))
IF 'INT
QUIT
Begin DoDot:2
+23 WRITE ?34,$GET(INSRCH("INTEXT",INT)),!
End DoDot:2
+24 DO CODETBL^INHERR3("MTYPE",4001.1,10)
+25 WRITE !,"Match type",?30," : ",MTYPE(INSRCH("INTYPE"))
End DoDot:1
+26 ;*** Interface message file
+27 ; display message start date
+28 IF INSRCH("INMSGSTART")]""
SET Y=INSRCH("INMSGSTART")+.000001
SET Y=$JUSTIFY(Y,12,4)
DO DD^%DT
WRITE !,"MESSAGE START DATE",?30," : ",Y
+29 ; display message end date
+30 IF INSRCH("INMSGEND")]""
SET Y=INSRCH("INMSGEND")-.000001
SET Y=$JUSTIFY(Y,12,4)
DO DD^%DT
WRITE !,"MESSAGE END DATE",?30," : ",Y
+31 ; display Message ID
+32 IF INSRCH("INID")]""
WRITE !,"MESSAGE ID",?30," : ",$GET(INSRCH("INID"))
+33 ; display direction
+34 IF INSRCH("INDIR")]""
SET C=$PIECE(^DD(4001.1,6,0),U,2)
SET Y=INSRCH("INDIR")
DO Y^DIQ
WRITE !,"DIRECTION",?30," : ",Y
+35 ; display Status
+36 IF INSRCH("INSTAT")]""
DO CODETBL^INHERR3("STAT",4001.1,3)
WRITE !,"STATUS",?30," : ",STAT(INSRCH("INSTAT"))
+37 ; display Source
+38 IF INSRCH("INSOURCE")]""
WRITE !,"SOURCE",?30," : ",$GET(INSRCH("INSOURCE"))
+39 ; display Patient
+40 IF INSRCH("INPAT")]""
SET C=$PIECE(^DD(4001.1,8,0),U,2)
SET Y=$GET(INSRCH("INPAT"))
DO Y^DIQ
WRITE !,"PATIENT",?30," : ",Y
+41 IF $DATA(INSRCH("TEXTLEN"))
WRITE !,"EXTRACT TEXT LENGTH",?30," : ",INSRCH("TEXTLEN")
IF INSRCH("TEXTLEN")>120
WRITE !?5,"NOTE : ACTUAL TEXT LENGTH MUST NOT EXCEED 120"
+42 WRITE !
+43 QUIT
