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

GMRVVZRT.m

Go to the documentation of this file. 
  1. GMRVVZRT ;DAL/GT-NDS VITAL SIGNS-CALLABLE ENTRY POINTS FOR ZRT SEGEMENT ;3/21/16
  1.  ;;5.0;GEN. MED. REC. - VITALS;**30**;MAR 21, 2016;Build 14
  1.  ;
  1.  ; This routine uses the following IAs:
  1.  ;  #6360 - FILE 120.51 CODING SYSTEM
  1.  ;  #6361 - FILE 120.52 CODING SYSTEM
  1.  ;  #6362 - FILE 120.53 CODING SYSTEM
  1.  ;
  1.  Q
  1. ZRT ;Manipulate update of MFN ZRT segment for 120.51,120.52,120.53 files
  1.  I IEN,((NAME="Term")!(NAME="Status")) K XXIEN ;This is the indication that it's first update for any subfile
  1.  S:$D(HLNODE(1)) HLNODE=HLNODE_HLNODE(1)
  1.     G 12051:IFN=120.51,12052:IFN=120.52,12053:IFN=120.53
  1.  Q
  1.  ;
  1. 12051 ;Manipulate update of MFN ZRT segment for 120.51 File
  1.  N X,XX,ERR,IENS,IEN1,IENX,X1,X2,X4,DA,DIK,I,FDAA
  1.  I IEN,NAME="VistA_Mapping_Target" D  Q  ;ZRT^VistA_CodingSystem_Mapping^LOINC:90701,90743
  1.  .S X=$P(HLNODE,HLFS,3) ;X=LOINC:90701,90743
  1.  .I '$L(X)!(X="""""") D DS(120.518,IEN) S OUT=1 Q  ;Q:$G(OUT)  ;If there is nothing coming from Push, wipe anything was there before
  1.  .I '$G(XXIEN(120.518)) D DS(120.518,IEN)  S XXIEN(120.518)=1 ;CLEAN SUBFILE ENTRY
  1.  .S X1=$P(X,":"),X2=$P(X,":",2)
  1.  .D DUP(120.518,X1,X2) ; Checup for duplicate coding system (ICD, 10D, CPT...) and codes
  1.  .Q:$G(ERROR)
  1.  .S IENS=IEN_","
  1.  .S IEN1="+1,",FDAA(120.518,"+1,"_IENS,.01)=X1
  1.  .F I=2:1 S X4=$P(X2,",",I-1) Q:'$L(X4)   S IENX="+"_I_","_IEN1_IENS,FDAA(120.5181,IENX,.01)=X4
  1.  .D:$D(FDAA) UPDATE^DIE("","FDAA",,"ERR")
  1.  .I $D(ERR) D  Q
  1.  ..S ERROR="1^subfile update error SUBFILE#: 120.5181 HLNODE:"_HLNODE
  1.  ..D EM^XUMF1H(ERROR,.ERR)
  1.  .Q:$G(ERROR)
  1.  .S OUT=1
  1.  Q
  1.  ;
  1. 12052 ;Manipulate update of MFN ZRT segment
  1.  N X,XX,ERR,IENS,IEN1,IENX,X1,X2,X4,DA,DIK,I,FDAA
  1.  I IEN,NAME="VistA_Mapping_Target" D  Q  ;ZRT^VistA_CodingSystem_Mapping^SNOMED:90701,90743
  1.  .S X=$P(HLNODE,HLFS,3) ;X=SMOMED:90701,90743
  1.  .I '$L(X)!(X="""""") D DS(120.522,IEN) S OUT=1 Q  ;Q:$G(OUT)  ;If there is nothing coming from Push, wipe anything was there before
  1.  .I '$G(XXIEN(120.522)) D DS(120.522,IEN)  S XXIEN(120.522)=1 ;CLEAN SUBFILE ENTRY
  1.  .S X1=$P(X,":"),X2=$P(X,":",2)
  1.  .D DUP(120.522,X1,X2) ; Checup for duplicate coding system (ICD, 10D, CPT...) and codes
  1.  .Q:$G(ERROR)
  1.  .S IENS=IEN_","
  1.  .S IEN1="+1,",FDAA(120.522,"+1,"_IENS,.01)=X1
  1.  .F I=2:1 S X4=$P(X2,",",I-1) Q:'$L(X4)   S IENX="+"_I_","_IEN1_IENS,FDAA(120.5221,IENX,.01)=X4
  1.  .D:$D(FDAA) UPDATE^DIE("","FDAA",,"ERR")
  1.  .I $D(ERR) D  Q
  1.  ..S ERROR="1^subfile update error SUBFILE#: 120.5221 HLNODE:"_HLNODE
  1.  ..D EM^XUMF1H(ERROR,.ERR)
  1.  .Q:$G(ERROR)
  1.  .S OUT=1
  1.  ;I IEN,NAME="has_qualifier" D  Q  ;
  1.  ;.I $P(HLNODE,HLFS,3)="""""" D DS(120.521,IEN) S OUT=1 Q
  1.  ;.I '$G(XXIEN(120.521)) D DS(120.521,IEN)  S XXIEN(120.521)=1 ;CLEAN SUBFILE ENTRY
  1.  Q
  1.  ;
  1. 12053 ;Manipulate update of MFN ZRT segment for 120.53 File
  1.  N X,XX,ERR,IENS,IEN1,IENX,X1,X2,X4,DA,DIK,I,FDAA
  1.  I IEN,NAME="VistA_Mapping_Target" D  Q  ;ZRT^VistA_CodingSystem_Mapping^SNOMED:90701,90743
  1.  .S X=$P(HLNODE,HLFS,3) ;X=SMOMED:90701,90743
  1.  .I '$L(X)!(X="""""") D DS(120.532,IEN) S OUT=1 Q  ;Q:$G(OUT)  ;If there is nothing coming from Push, wipe anything was there before
  1.  .I '$G(XXIEN(120.532)) D DS(120.532,IEN)  S XXIEN(120.532)=1 ;CLEAN SUBFILE ENTRY
  1.  .S X1=$P(X,":"),X2=$P(X,":",2)
  1.  .D DUP(120.532,X1,X2) ; Checup for duplicate coding system (ICD, 10D, CPT...) and codes
  1.  .Q:$G(ERROR)
  1.  .S IENS=IEN_","
  1.  .S IEN1="+1,",FDAA(120.532,"+1,"_IENS,.01)=X1
  1.  .F I=2:1 S X4=$P(X2,",",I-1) Q:'$L(X4)  S IENX="+"_I_","_IEN1_IENS,FDAA(120.5321,IENX,.01)=X4
  1.  .D:$D(FDAA) UPDATE^DIE("","FDAA",,"ERR")
  1.  .I $D(ERR) D  Q
  1.  ..S ERROR="1^subfile update error SUBFILE#: 120.5321 HLNODE:"_HLNODE
  1.  ..D EM^XUMF1H(ERROR,.ERR)
  1.  .Q:$G(ERROR)
  1.  .S OUT=1
  1.  Q
  1.  ;
  1. DS(SUBFILE,IENS) ;Delete subfile
  1.  N ROOT,IDX,X
  1.  S ROOT=$$ROOT^DILFD(SUBFILE,","_IENS,1)
  1.  S IDX=0 F  S IDX=$O(@ROOT@(IDX)) Q:'IDX  D
  1.  .N DA,DIK,DIC S DA(1)=+IENS,DA=IDX,DIK=$P(ROOT,")")_"," D ^DIK
  1.  Q
  1.  ;
  1. DUP(SUB,X1,X2) ;
  1.  ;Checkup for duplicate coding system (ICD, 10D, CPT...)
  1.  D GETS^DIQ(IFN,IEN_",","**","","TMP") ;TMP(120.518 - .128,"1,7,",.01)=86485   X1=CPT   X2=1234,4567,7890
  1.  S II="" F  S II=$O(TMP(SUB,II)) Q:'II  S X3=$G(TMP(SUB,II,.01)) I $L(X3),X3=X1 D  Q
  1.  .S ERROR="1^Error - "_II_" Duplicate Coding System"_" File #: "_IFN_" HLNODE="_HLNODE
  1.  Q:$G(ERROR)
  1.  ;Checkup for duplicate codes. (CPT:90701,90743,90701)
  1.  N X6
  1.  F I=1:1 S X5=$P(X2,",",I) Q:'$L(X5)  S X6(X5)=$G(X6(X5))+1 I X6(X5)>1 D  Q
  1.  .S ERROR="1^Error - Duplicate Codes in Coding System"_" File #: "_IFN_" HLNODE="_HLNODE ;D ^%ZTER
  1.  Q
  1. M12051 ;Conversion of File: 120.51 FIELD: 8  CODING SYSTEM  From: CPT to CPT:00001,00002
  1.  ;TMP1(2,"120.518","1,7,",".01")="CPT"    D GETS^DIQ(X2,IENS,"*","","TMP1(LEV)")
  1.  N TMP,X4,X3,II
  1.  S X4=TMP1(LEV,X2,IENS,I)_":" ;X4=CPT:
  1.  D GETS^DIQ(120.518,IENS,"**","","TMP") ;TMP(120.5181,"1,1,7,",.01)=86485
  1.  S II="" F  S II=$O(TMP(120.5181,II)) Q:'II  S X3=$G(TMP(120.5181,II,.01)) S:$L(X3) X4=X4_X3_","
  1.  S:$L(X3) X4=$E(X4,1,$L(X4)-1) S TMP1(LEV,X2,IENS,I)=X4
  1.  Q
  1. M12052 ;Conversion of File:120.52 FIELD: 2  CODING SYSTEM  From: CPT to CPT:00001,00002
  1.  ;TMP1(2,"120.522","1,7,",".01")="CPT"    D GETS^DIQ(X2,IENS,"*","","TMP1(LEV)")
  1.  N TMP,X4,X3,II
  1.  S X4=TMP1(LEV,X2,IENS,I)_":" ;X4=CPT:
  1.  D GETS^DIQ(120.522,IENS,"**","","TMP") ;TMP(120.5221"1,1,7,",.01)=86485
  1.  S II="" F  S II=$O(TMP(120.5221,II)) Q:'II  S X3=$G(TMP(120.5221,II,.01)) S:$L(X3) X4=X4_X3_","
  1.  ;S X4=$S($L(X3):$E(X4,1,$L(X4)-1),1:"") S TMP1(LEV,X2,IENS,I)=X4
  1.  S:$L(X3) X4=$E(X4,1,$L(X4)-1) S TMP1(LEV,X2,IENS,I)=X4
  1.  Q
  1. M12053 ;Conversion of File:120.53 FIELD: 2  CODING SYSTEM  From: CPT to CPT:00001,00002
  1.  ;TMP1(2,"120.532","1,7,",".01")="CPT"    D GETS^DIQ(X2,IENS,"*","","TMP1(LEV)")
  1.  N TMP,X4,X3,II
  1.  S X4=TMP1(LEV,X2,IENS,I)_":" ;X4=CPT:
  1.  D GETS^DIQ(120.532,IENS,"**","","TMP") ;TMP(120.5321,"1,1,7,",.01)=86485
  1.  S II="" F  S II=$O(TMP(120.5321,II)) Q:'II  S X3=$G(TMP(120.5321,II,.01)) S:$L(X3) X4=X4_X3_","
  1.  ;S X4=$S($L(X3):$E(X4,1,$L(X4)-1),1:"") S TMP1(LEV,X2,IENS,I)=X4
  1.  S:$L(X3) X4=$E(X4,1,$L(X4)-1) S TMP1(LEV,X2,IENS,I)=X4
  1.  Q