Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: INHES1

INHES1.m

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