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

GMRAXNKA.m

Go to the documentation of this file. 
  1. GMRAXNKA ;HIRMFO/WAA- No Known Allergies Conversion ; 8/27/93
  1.  ;;4.0;Adverse Reaction Tracking;;Mar 29, 1996
  1. EN1 ; Data conversion of Patient Allergies file from v3.0 -> v4.0
  1.  ;  This conversion does two things:
  1.  ;    1) Moves those records which represent whether a patient
  1.  ;       has been asked about allergies (NKA nodes) from the
  1.  ;       Patient Allergies (120.8) to Adverse Reaction Assessment 
  1.  ;       (120.86) file.
  1.  ;    2) Converts the set of codes of Comment Type (1.5) sub-field
  1.  ;       of the Comments (26) field from old values to new values.
  1.  ;         Old       New
  1.  ;         ---       ---
  1.  ;          y         V
  1.  ;          n         O
  1.  ;
  1.  K GMRATXT S GMRATXT(1)="Move 120.8 NKA Cross Reference to 120.86...." D BMES^XPDUTL(.GMRATXT) K GMRATXT
  1.  S GMRAPA=0 F  S GMRAPA=$O(^GMR(120.8,GMRAPA)) Q:GMRAPA'>0  D
  1.  . S GMRAPA(0)=$G(^GMR(120.8,GMRAPA,0)) Q:GMRAPA(0)=""
  1.  . S GMAYN=$P(GMRAPA(0),U,22)
  1.  . I $L($P(GMRAPA(0),U,2)) D  ; convert comments.
  1.  . . D COMMENTS(GMRAPA)
  1.  . . Q
  1.  . E  I GMAYN'="" D  ; Move NKA entry out of file 120.8
  1.  . . D NKA(.GMRAPA)
  1.  . . Q
  1.  . Q
  1.  S DA(1)=120.8,DA=.03,DIK="^DD("_DA(1)_"," D ^DIK ; delete .03 field.
  1.  K ^GMR(120.8,"ANKA") ; Kill off any remaining "ANKA" xrefs.
  1.  Q
  1. NKA(GMAPA) ; Move No Known Allergies field from 120.8 file to 120.86 file.
  1.  G:+$G(^GMR(120.8,GMAPA,"ER")) ERR ; if node E/E don't move to 120.86
  1.  N DFN,GMAYNN,GMAX
  1.  S DFN=$P(GMAPA(0),U) G:DFN'>0 ERR ; if no patient, dont move to 120.86
  1.  I '$D(^GMR(120.86,DFN,0)) D  ; Add a new 120.86 file entry.
  1.  . S GMAX=$G(^GMR(120.86,0)) S:GMAX="" GMAX="ADVERSE REACTION ASSESSMENT^120.86P^0^0"
  1.  . S $P(GMAX,U,3,4)=$S(DFN>$P(GMAX,U,3):DFN,1:$P(GMAX,U,3))_U_($P(GMAX,U,4)+1)
  1.  . S ^GMR(120.86,DFN,0)=DFN
  1.  . S DIK="^GMR(120.86,",DA=DFN D IX1^DIK
  1.  . S ^GMR(120.86,0)=GMAX
  1.  . Q
  1.  S GMAYNN=$P($G(^GMR(120.86,DFN,0)),U,2),GMAYN=$P(GMAPA(0),U,22)
  1.  I GMAYNN'="y",GMAYNN=""!(GMAYNN="n"&(GMAYN="y")) D  ; update file 120.86
  1.  . N GMRAYN S GMRAYN=$S($P(GMAPA(0),U,22)="y":"1",1:"0")
  1.  . S DR="1////"_GMRAYN_";2////"_$P(GMAPA(0),U,5)_";3////"_$P(GMAPA(0),U,4)
  1.  . S DIE="^GMR(120.86,"  D ^DIE
  1.  . Q
  1. ERR ; jump here if this NKA node was entered in error, or no patient found
  1.  S DIK="^GMR(120.8,",DA=GMAPA D ^DIK ; delete old entry
  1.  W:'$D(ZTQUEUED)&'$R(100) "."
  1.  Q
  1. COMMENTS(GMAPA) ; Convert comments
  1.  Q:'$D(^GMR(120.8,GMAPA,26,0))  ; no comments to convert
  1.  N GMAPC,GMAX,GMAY,GMAZ
  1.  S GMAPC=0 F  S GMAPC=$O(^GMR(120.8,GMAPA,26,GMAPC)) Q:GMAPC<1  D
  1.  .S GMAY=$G(^GMR(120.8,GMAPA,26,GMAPC,0)) Q:GMAY=""
  1.  .S GMAX=$P(GMAY,U,3) Q:"^y^n^"'[(U_GMAX_U)
  1.  .S GMAZ=$S(GMAX="y":"V",1:"O")
  1.  .S DA(1)=GMAPA,DA=GMAPC,DIE="^GMR(120.8,"_DA(1)_",26,",DR="1.5////"_GMAZ
  1.  .D ^DIE W:'$D(ZTQUEUED)&'$R(50) "."
  1.  .Q
  1.  Q