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

INHSYS01.m

Go to the documentation of this file. 
  1. INHSYS01 ;SLT,JPD; 1 Apr 99 10:05;GIS configuration compilation utility
  1.  ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
  1.  ;COPYRIGHT 1991-2000 SAIC
  1.  ;CHCS TOOLS_460; GEN 3; 17-JUL-1997
  1.  ;COPYRIGHT 1992 SAIC
  1.  Q
  1. XTRK(%XIEN,%ROOT,%UTL,%FILE,INREPRT,%LEVEL) ;global data extract and store
  1.  ;input:
  1.  ;  %XIEN - ien of RECORD extracting data from
  1.  ;  %ROOT - global root in fileman format
  1.  ;  %UTL  - temporary storage buffer
  1.  ;  %FILE - file 4000,4005,4006,4004,4011,4010,4012,4090.2,4012.1,4020 
  1.  ;  INREPRT - 0-No report
  1.  ;            1-Report
  1.  ;  %LEVEL - Indentation level of report
  1.  N ND,INY,GBL,INIEN,INCHLD,I,INBPC,INSGM,INSGS,INSGF,INSGSF
  1.  Q:'%XIEN
  1.  S ND=%ROOT_%XIEN_")",INREPRT=+$G(INREPRT)
  1.  ;
  1.  ;loop through file store in ^UTILITY and get pointer relationships
  1.  F  S ND=$Q(@ND) Q:%XIEN'=+$P(ND,%ROOT,2)  D  Q:INPOP
  1.  .;get data and store in UTILITY global
  1.  .S INY=@ND,GBL=%UTL_$P(ND,%ROOT,2),@GBL=INY
  1.  .I $$ZRONOD(ND,%XIEN,%ROOT) D  Q:INPOP
  1.  ..;do report, store copy of node for later
  1.  ..I INREPRT D RPRT1^INHSYSUT(%LEVEL,%FILE,ND) S ^UTILITY("SVD",$J,ND)=""
  1.  .;
  1.  .;Check Transaction type file for pointers
  1.  .I %FILE=4000,$$ZRONOD(ND,%XIEN,%ROOT) D TTYPE^INHSYS02(INY,%XIEN,INREPRT,%LEVEL)
  1.  .;
  1.  .;Interface destination file 4005
  1.  .I %FILE=4005,$$ZRONOD(ND,%XIEN,%ROOT) D DF(INY,%XIEN,INREPRT,%LEVEL)
  1.  .;
  1.  .;Background Processes file 4004
  1.  .I %FILE=4004,$$ZRONOD(ND,%XIEN,%ROOT),+$P(INY,U,7) D XTRK0(+$P(INY,U,7),4005,"^INRHD(",INREPRT,%LEVEL)
  1.  .;
  1.  .;Script Generator Message File 4011
  1.  .I %FILE=4011,$$ZRONOD(ND,%XIEN,%ROOT) D SEGS(%XIEN,INREPRT,%LEVEL)
  1.  .;
  1.  .;Script Generator Segment File 4010
  1.  .I %FILE=4010,$$ZRONOD(ND,%XIEN,%ROOT) D FLDS(%XIEN,INREPRT,%LEVEL)
  1.  .;
  1.  .;Script Generator Field Field File 4012
  1.  .I %FILE=4012,$$ZRONOD(ND,%XIEN,%ROOT) D MAP(%ROOT,%XIEN,INREPRT,%LEVEL)
  1.  .;
  1.  .;Interface Message Replication
  1.  .I %FILE=4020,$$ZRONOD(ND,%XIEN,%ROOT),+$P(INY,U,2) D XTRK0(+$P(INY,U,2),4000,"^INRHT(",INREPRT,%LEVEL)
  1.  .;don't take 4012.1 data type pointer
  1.  .;I %FILE=4090.2 don't do anything with data element map func file
  1.  .;I %FILE=4012.1 - script gen data type file points to nothing
  1.  .;I %FILE=4006 - Points to nothing
  1.  Q
  1.  ;
  1. MAP(%ROOT,%XIEN,INREPRT,%LEVEL) ;Map file
  1.  ; Input:
  1.  ; %ROOT - Global root in fileman format
  1.  ; %XIEN - Map File ien
  1.  ; %LEVEL - Pointer level
  1.  N INIEN
  1.  ;map pointer to 4090.2 data element map function file
  1.  S INIEN=$G(@$E(%ROOT,1,$L(%ROOT)-1)@(%XIEN,50))
  1.  ;extract 4090.2
  1.  I INIEN D XTRK0(INIEN,4090.2,"^INVD(",INREPRT,%LEVEL)
  1.  Q
  1. XTRK0(%INP,%FL,%ND,INREPRT,%LEVEL) ;
  1.  ; %INP - Pointer to file from piece
  1.  ; %FL - DD file number
  1.  ; %ND - Root
  1.  ; INREPRT - 0 no report 1 - report
  1.  ; %LEVEL - Pointer level
  1.  ;
  1.  I '$D(^UTILITY($J,%FL,%INP)) D XTRK(%INP,%ND,"^UTILITY($J,"""_%FL_""",",%FL,INREPRT,%LEVEL+1)
  1.  Q
  1. DF(INY,%XIEN,INREPRT,%LEVEL) ;Destination file
  1.  ;Input:
  1.  ; INY-Data from node
  1.  ; %XIEN - ien of 4005
  1.  ; INREPRT - 0 no report
  1.  ;          1 report
  1.  ; %LEVEL - Pointer level
  1.  N %IP2,%IP10
  1.  ; -- Transaction Type and Acceptance TT
  1.  S %IP2=+$P(INY,U,2),%IP10=+$P(INY,U,10)
  1.  ; - TT pointer to file 4000 exists
  1.  I %IP2 D XTRK0(%IP2,4000,"^INRHT(",INREPRT,%LEVEL) Q:INPOP
  1.  ; - Acceptance TT pointer to file 4000 exists
  1.  I %IP10 D XTRK0(%IP10,4000,"^INRHT(",INREPRT,%LEVEL) Q:INPOP
  1.  ; - Primary Destination pointers to 4005, backwards and forwards
  1.  D DP(%XIEN,INREPRT,%LEVEL) Q:INPOP
  1.  ;Look for background process which points to this 4005
  1.  D BP(%XIEN,INREPRT,%LEVEL) Q:INPOP
  1.  Q
  1. DP(%XIEN,INREPRT,%LEVEL) ;Primary Destination Pointers 4005
  1.  ; Input: 
  1.  ; %XIEN - Ien of current entry
  1.  ; INREPRT - 0 no report
  1.  ;          1 report
  1.  ; %LEVEL - Pointer level
  1.  N INIEN
  1.  ; If a sub-destination, Get primary
  1.  S INIEN=$G(^INRHD(%XIEN,7)),INIEN=$P(INIEN,U,2)
  1.  I INIEN D XTRK0(INIEN,4005,"^INRHD(",INREPRT,%LEVEL)
  1.  ; Get sub-destinations
  1.  S INIEN=""
  1.  F  S INIEN=$O(^INRHD("APD",%XIEN,INIEN)) Q:'INIEN  D XTRK0(INIEN,4005,"^INRHD(",INREPRT,%LEVEL) Q:INPOP
  1.  Q
  1. BP(%XIEN,INREPRT,%LEVEL) ;Background processes 4004
  1.  ; Input: 
  1.  ; %XIEN - Ien of destination file
  1.  ; INREPRT - 0 no report
  1.  ;          1 report
  1.  ; %LEVEL - Pointer level
  1.  N INBPC,%LEN,INIEN,I
  1.  S INBPC=$$BPC(%XIEN),%LEN=$L(INBPC,U)
  1.  F I=1:1:%LEN D  Q:INPOP
  1.  .S INIEN=$P(INBPC,U,I) Q:'INIEN
  1.  .;Background Process Control entry
  1.  .D XTRK0(INIEN,4004,"^INTHPC(",INREPRT,%LEVEL)
  1.  Q
  1. BPC(X) ;find all background processes which point to this destination 4004 cont
  1.  ;input:
  1.  ;  X - destination ien
  1.  ;return:
  1.  ;  INY - '^' delimited string of background process iens
  1.  ;
  1.  N INY,%A
  1.  S %A=0,INY=""
  1.  F  S %A=$O(^INTHPC(%A)) Q:'%A  D
  1.  .I $P($G(^INTHPC(%A,0)),U,7)=X S INY=INY_$S(INY]"":U,1:"")_%A
  1.  Q INY
  1. SEGS(%XIEN,INREPRT,%LEVEL) ;Script segs 4011
  1.  ; Input:
  1.  ; %XIEN - Scripts file Ien
  1.  ; INREPRT - 0 no report
  1.  ;          1 report
  1.  ; %LEVEL - Pointer level
  1.  N INSGS,%LEN,I,INIEN
  1.  S INSGS=$$SGS(%XIEN),%LEN=$L(INSGS,U)
  1.  F I=1:1:%LEN D  Q:INPOP
  1.  .S INIEN=$P(INSGS,U,I)
  1.  .;4010's script generator segment file entries
  1.  .I INIEN D XTRK0(INIEN,4010,"^INTHL7S(",INREPRT,%LEVEL)
  1.  Q
  1. SGS(%XIEN) ;return '^' delimited string of segment iens
  1.  ;input:
  1.  ;  %XIEN - Script Generator Message ien
  1.  ;return:
  1.  ;  INY - '^' delimited string of segment iens
  1.  ;
  1.  N INSEG,INPSEG,DA,INY
  1.  ;figure out which 4010's to save
  1.  S (INY,INSEG)="" F  S INSEG=$O(^INTHL7M(%XIEN,1,"B",INSEG)) Q:'INSEG  D
  1.  .S INY=INY_$S(INY]"":U,1:"")_INSEG
  1.  .S DA=$O(^INTHL7M(%XIEN,1,"B",INSEG,"")),INPSEG=$S(DA'="":$P($G(^INTHL7M(%XIEN,1,DA,0)),U,11),1:"")
  1.  .S INY=INY_$S(INY]""&(INPSEG]""):U,1:"")_INPSEG
  1.  Q INY
  1.  ;
  1. FLDS(%XIEN,INREPRT,%LEVEL) ;Fields file - 4012
  1.  ; Input:
  1.  ; %XIEN - Fields File Ien
  1.  ; INREPRT - 0 no report
  1.  ;          1 report
  1.  ; %LEVEL - Pointer level
  1.  N INSGF,INSGSF,I,INIEN,J
  1.  ;field multiple of 4010 script gen seg file
  1.  S INSGF=$$SGF(%XIEN,.INSGF) F I=1:1:INSGF D  Q:INPOP
  1.  .S INIEN=INSGF(I) Q:'INIEN
  1.  .;script generator field exists
  1.  .Q:$D(^UTILITY($J,4012,INIEN))
  1.  .;get sub field multiple entry of 4012 script gen field file
  1.  .K INSGSF S INSGSF=$$SGSF(INIEN,.INSGSF) F J=1:1:INSGSF D  Q:INPOP
  1.  ..N INIEN S INIEN=INSGSF(J)
  1.  ..I INIEN D XTRK0(INIEN,4012,"^INTHL7F(",INREPRT,%LEVEL)
  1.  Q
  1. SGF(X,INSGF) ;return the number of field iens found
  1.  ;input:
  1.  ;  X - Segment ien
  1.  ;  INSGF - Array of field iens built, passed by referrence
  1.  ;
  1.  N INFLD,INY
  1.  S (INFLD,INY)=""
  1.  F  S INFLD=$O(^INTHL7S(X,1,"B",INFLD)) Q:'INFLD  S INY=INY+1,INSGF(INY)=INFLD
  1.  Q +INY
  1.  ;
  1. SGSF(X,INSGSF) ;return the number of sub-field iens
  1.  ;input:
  1.  ;  X - field ien
  1.  ;  INSGSF - Array of subfield iens built, passed by referrence
  1.  ;
  1.  N INFLD,INY
  1.  S INFLD="",INY=1,INSGSF(1)=X
  1.  F  S INFLD=$O(^INTHL7F(X,10,"B",INFLD)) Q:'INFLD  S INY=INY+1,INSGSF(INY)=INFLD
  1.  Q +INY
  1. ZRONOD(N,X,R) ;is node the first level zero node?
  1.  ;input:
  1.  ;  N - node
  1.  ;  X - ien
  1.  ;  R - global root
  1.  ;Returns 1 if node is 0 node, 0 if not
  1.  N %ZND S %ZND=R_X_",0)"
  1.  Q N=%ZND