GMRAXNKA ;HIRMFO/WAA- No Known Allergies Conversion ; 8/27/93
;;4.0;Adverse Reaction Tracking;;Mar 29, 1996
EN1 ; Data conversion of Patient Allergies file from v3.0 -> v4.0
; This conversion does two things:
; 1) Moves those records which represent whether a patient
; has been asked about allergies (NKA nodes) from the
; Patient Allergies (120.8) to Adverse Reaction Assessment
; (120.86) file.
; 2) Converts the set of codes of Comment Type (1.5) sub-field
; of the Comments (26) field from old values to new values.
; Old New
; --- ---
; y V
; n O
;
K GMRATXT S GMRATXT(1)="Move 120.8 NKA Cross Reference to 120.86...." D BMES^XPDUTL(.GMRATXT) K GMRATXT
S GMRAPA=0 F S GMRAPA=$O(^GMR(120.8,GMRAPA)) Q:GMRAPA'>0 D
. S GMRAPA(0)=$G(^GMR(120.8,GMRAPA,0)) Q:GMRAPA(0)=""
. S GMAYN=$P(GMRAPA(0),U,22)
. I $L($P(GMRAPA(0),U,2)) D ; convert comments.
. . D COMMENTS(GMRAPA)
. . Q
. E I GMAYN'="" D ; Move NKA entry out of file 120.8
. . D NKA(.GMRAPA)
. . Q
. Q
S DA(1)=120.8,DA=.03,DIK="^DD("_DA(1)_"," D ^DIK ; delete .03 field.
K ^GMR(120.8,"ANKA") ; Kill off any remaining "ANKA" xrefs.
Q
NKA(GMAPA) ; Move No Known Allergies field from 120.8 file to 120.86 file.
G:+$G(^GMR(120.8,GMAPA,"ER")) ERR ; if node E/E don't move to 120.86
N DFN,GMAYNN,GMAX
S DFN=$P(GMAPA(0),U) G:DFN'>0 ERR ; if no patient, dont move to 120.86
I '$D(^GMR(120.86,DFN,0)) D ; Add a new 120.86 file entry.
. S GMAX=$G(^GMR(120.86,0)) S:GMAX="" GMAX="ADVERSE REACTION ASSESSMENT^120.86P^0^0"
. S $P(GMAX,U,3,4)=$S(DFN>$P(GMAX,U,3):DFN,1:$P(GMAX,U,3))_U_($P(GMAX,U,4)+1)
. S ^GMR(120.86,DFN,0)=DFN
. S DIK="^GMR(120.86,",DA=DFN D IX1^DIK
. S ^GMR(120.86,0)=GMAX
. Q
S GMAYNN=$P($G(^GMR(120.86,DFN,0)),U,2),GMAYN=$P(GMAPA(0),U,22)
I GMAYNN'="y",GMAYNN=""!(GMAYNN="n"&(GMAYN="y")) D ; update file 120.86
. N GMRAYN S GMRAYN=$S($P(GMAPA(0),U,22)="y":"1",1:"0")
. S DR="1////"_GMRAYN_";2////"_$P(GMAPA(0),U,5)_";3////"_$P(GMAPA(0),U,4)
. S DIE="^GMR(120.86," D ^DIE
. Q
ERR ; jump here if this NKA node was entered in error, or no patient found
S DIK="^GMR(120.8,",DA=GMAPA D ^DIK ; delete old entry
W:'$D(ZTQUEUED)&'$R(100) "."
Q
Q:'$D(^GMR(120.8,GMAPA,26,0)) ; no comments to convert
N GMAPC,GMAX,GMAY,GMAZ
S GMAPC=0 F S GMAPC=$O(^GMR(120.8,GMAPA,26,GMAPC)) Q:GMAPC<1 D
.S GMAY=$G(^GMR(120.8,GMAPA,26,GMAPC,0)) Q:GMAY=""
.S GMAX=$P(GMAY,U,3) Q:"^y^n^"'[(U_GMAX_U)
.S GMAZ=$S(GMAX="y":"V",1:"O")
.S DA(1)=GMAPA,DA=GMAPC,DIE="^GMR(120.8,"_DA(1)_",26,",DR="1.5////"_GMAZ
.D ^DIE W:'$D(ZTQUEUED)&'$R(50) "."
.Q
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRAXNKA 2739 printed Nov 22, 2024@16:51:01 Page 2
GMRAXNKA ;HIRMFO/WAA- No Known Allergies Conversion ; 8/27/93
+1 ;;4.0;Adverse Reaction Tracking;;Mar 29, 1996
EN1 ; Data conversion of Patient Allergies file from v3.0 -> v4.0
+1 ; This conversion does two things:
+2 ; 1) Moves those records which represent whether a patient
+3 ; has been asked about allergies (NKA nodes) from the
+4 ; Patient Allergies (120.8) to Adverse Reaction Assessment
+5 ; (120.86) file.
+6 ; 2) Converts the set of codes of Comment Type (1.5) sub-field
+7 ; of the Comments (26) field from old values to new values.
+8 ; Old New
+9 ; --- ---
+10 ; y V
+11 ; n O
+12 ;
+13 KILL GMRATXT
SET GMRATXT(1)="Move 120.8 NKA Cross Reference to 120.86...."
DO BMES^XPDUTL(.GMRATXT)
KILL GMRATXT
+14 SET GMRAPA=0
FOR
SET GMRAPA=$ORDER(^GMR(120.8,GMRAPA))
if GMRAPA'>0
QUIT
Begin DoDot:1
+15 SET GMRAPA(0)=$GET(^GMR(120.8,GMRAPA,0))
if GMRAPA(0)=""
QUIT
+16 SET GMAYN=$PIECE(GMRAPA(0),U,22)
+17 ; convert comments.
IF $LENGTH($PIECE(GMRAPA(0),U,2))
Begin DoDot:2
+18 DO COMMENTS(GMRAPA)
+19 QUIT
End DoDot:2
+20 ; Move NKA entry out of file 120.8
IF '$TEST
IF GMAYN'=""
Begin DoDot:2
+21 DO NKA(.GMRAPA)
+22 QUIT
End DoDot:2
+23 QUIT
End DoDot:1
+24 ; delete .03 field.
SET DA(1)=120.8
SET DA=.03
SET DIK="^DD("_DA(1)_","
DO ^DIK
+25 ; Kill off any remaining "ANKA" xrefs.
KILL ^GMR(120.8,"ANKA")
+26 QUIT
NKA(GMAPA) ; Move No Known Allergies field from 120.8 file to 120.86 file.
+1 ; if node E/E don't move to 120.86
if +$GET(^GMR(120.8,GMAPA,"ER"))
GOTO ERR
+2 NEW DFN,GMAYNN,GMAX
+3 ; if no patient, dont move to 120.86
SET DFN=$PIECE(GMAPA(0),U)
if DFN'>0
GOTO ERR
+4 ; Add a new 120.86 file entry.
IF '$DATA(^GMR(120.86,DFN,0))
Begin DoDot:1
+5 SET GMAX=$GET(^GMR(120.86,0))
if GMAX=""
SET GMAX="ADVERSE REACTION ASSESSMENT^120.86P^0^0"
+6 SET $PIECE(GMAX,U,3,4)=$SELECT(DFN>$PIECE(GMAX,U,3):DFN,1:$PIECE(GMAX,U,3))_U_($PIECE(GMAX,U,4)+1)
+7 SET ^GMR(120.86,DFN,0)=DFN
+8 SET DIK="^GMR(120.86,"
SET DA=DFN
DO IX1^DIK
+9 SET ^GMR(120.86,0)=GMAX
+10 QUIT
End DoDot:1
+11 SET GMAYNN=$PIECE($GET(^GMR(120.86,DFN,0)),U,2)
SET GMAYN=$PIECE(GMAPA(0),U,22)
+12 ; update file 120.86
IF GMAYNN'="y"
IF GMAYNN=""!(GMAYNN="n"&(GMAYN="y"))
Begin DoDot:1
+13 NEW GMRAYN
SET GMRAYN=$SELECT($PIECE(GMAPA(0),U,22)="y":"1",1:"0")
+14 SET DR="1////"_GMRAYN_";2////"_$PIECE(GMAPA(0),U,5)_";3////"_$PIECE(GMAPA(0),U,4)
+15 SET DIE="^GMR(120.86,"
DO ^DIE
+16 QUIT
End DoDot:1
ERR ; jump here if this NKA node was entered in error, or no patient found
+1 ; delete old entry
SET DIK="^GMR(120.8,"
SET DA=GMAPA
DO ^DIK
+2 if '$DATA(ZTQUEUED)&'$RANDOM(100)
WRITE "."
+3 QUIT
+1 ; no comments to convert
if '$DATA(^GMR(120.8,GMAPA,26,0))
QUIT
+2 NEW GMAPC,GMAX,GMAY,GMAZ
+3 SET GMAPC=0
FOR
SET GMAPC=$ORDER(^GMR(120.8,GMAPA,26,GMAPC))
if GMAPC<1
QUIT
Begin DoDot:1
+4 SET GMAY=$GET(^GMR(120.8,GMAPA,26,GMAPC,0))
if GMAY=""
QUIT
+5 SET GMAX=$PIECE(GMAY,U,3)
if "^y^n^"'[(U_GMAX_U)
QUIT
+6 SET GMAZ=$SELECT(GMAX="y":"V",1:"O")
+7 SET DA(1)=GMAPA
SET DA=GMAPC
SET DIE="^GMR(120.8,"_DA(1)_",26,"
SET DR="1.5////"_GMAZ
+8 DO ^DIE
if '$DATA(ZTQUEUED)&'$RANDOM(50)
WRITE "."
+9 QUIT
End DoDot:1
+10 QUIT
