GMRAGUI ;SLC/DAN - CPRS GUI support ;12/22/04 10:16
;;4.0;Adverse Reaction Tracking;**21**;Mar 29, 1996
;
GETREC(GMRAIEN,GMRARRAY) ;
;GMRAIEN = IEN of object record from file 120.8
;GMRARRAY = array specifier ie.^TMP($J,"ART")
K @GMRARRAY
N ND,STRING,SSNODE,GMRA,GMRACA,GMRAT,GMRANOR,SSLIM,SSNUM,GMRASSI,GMRASS,GMRADT,Y,GMRAODUZ,COMFLAG,COMNUM,I
N COMMENTS,GMRACODT,GMRACDUZ,GMRACUS,PREFIX,COMLINE,IDMNOD,IDMLIM,IDMNUM,GMRAIDB,CHMNOD,CHMLIM,CHMNUM,GMRACHM,GMRAVDUZ,GMRAVYN,GMRAOBS,OBSIEN,USRNAM,USR,SEVCOD,SEVER
S ND=1
I '$D(GMRAIEN)!('+GMRAIEN) Q
S GMRA(0)=$G(^GMR(120.8,+GMRAIEN,0)) Q:'$L(GMRA(0))
S STRING="~CAUSATIVE AGENT" D NEXT
S GMRACA=$P(GMRA(0),U,2)
S STRING="d"_GMRACA D NEXT
S STRING="~ALLERGY TYPE" D NEXT
S GMRAT=$P(GMRA(0),U,20)
S STRING="d"_GMRAT_"^"_$TR($$OUTTYPE^GMRAUTL(GMRAT)," ","") D NEXT
S STRING="~NATURE OF REACTION" D NEXT
S GMRANOR=$P(GMRA(0),U,14)
S STRING="d"_GMRANOR_U_$S(GMRANOR="A":"ALLERGY",GMRANOR="R":"ADVERSE REACTION",GMRANOR="P":"PHARMACOLOGICAL",1:"UNKNOWN") D NEXT
S STRING="~SIGN/SYMPTOMS" D NEXT
S SSNODE=$G(^GMR(120.8,GMRAIEN,10,0)),SSLIM=$P(SSNODE,U,3),SSNUM=0
I SSLIM<1 G ORIG
SSLOOP S SSNUM=$O(^GMR(120.8,GMRAIEN,10,SSNUM))
I SSNUM<1!(SSNUM>SSLIM) G ORIG
S GMRASSI=$P($G(^GMR(120.8,GMRAIEN,10,SSNUM,0)),U,1),GMRASS=$P($G(^GMRD(120.83,GMRASSI,0)),U,1),GMRADT=$P($G(^GMR(120.8,GMRAIEN,10,SSNUM,0)),U,4)
S Y=$$FMTE^XLFDT(GMRADT,"D")
S STRING="i"_GMRASSI_"^"_GMRASS_"^"_GMRADT_"^ "_Y D NEXT G SSLOOP
ORIG S STRING="~ORIGINATOR" D NEXT
S GMRAODUZ=$P(GMRA(0),U,5)
S STRING="d"_GMRAODUZ_"^"_$S(GMRAODUZ:$$GET1^DIQ(200,GMRAODUZ_",",".01"),1:"") D NEXT
S STRING="~ORIGINATED" D NEXT
S STRING="d"_$P(GMRA(0),U,4) D NEXT
S COMFLAG=0,COMNUM=0
S STRING="~COMMENTS" D NEXT
S COMMENTS=$G(^GMR(120.8,GMRAIEN,26,0)) S:COMMENTS'="" COMFLAG=1
CLOOP1 I COMFLAG D ;
.S COMNUM=$O(^GMR(120.8,GMRAIEN,26,COMNUM))
.Q:COMNUM<1
.S GMRACODT=$P($G(^GMR(120.8,GMRAIEN,26,COMNUM,0)),U,1)
. S Y=$$FMTE^XLFDT(GMRACODT,"D")
. S STRING="tComment Date: "_Y
.D NEXT
.S GMRACDUZ=$P($G(^GMR(120.8,GMRAIEN,26,COMNUM,0)),U,2) S GMRACUS=$S('GMRACDUZ:"",1:$$GET1^DIQ(200,GMRACDUZ_",",".01"))
.S STRING="tEntered By : "_GMRACUS
.D NEXT
.S PREFIX="tComments : "
.S COMLINE=$O(^GMR(120.8,GMRAIEN,26,COMNUM,2,0))
CLOOP2 .D:COMLINE ;
..S STRING=PREFIX_$G(^GMR(120.8,GMRAIEN,26,COMNUM,2,COMLINE,0)) D NEXT
..S PREFIX="t "
.S COMLINE=$O(^GMR(120.8,GMRAIEN,26,COMNUM,2,COMLINE))
.I COMLINE>0 G CLOOP2
.S STRING="t"
.F I=1:1:60 S STRING=STRING_"-"
.D NEXT
I COMNUM>0 G CLOOP1
IDBM S STRING="~ID BAND MARKED" D NEXT
S IDMNOD=$G(^GMR(120.8,GMRAIEN,14,0)),IDMLIM=$P(IDMNOD,U,3),IDMNUM=0
I IDMLIM<1 G CHM
IDBLOOP S IDMNUM=$O(^GMR(120.8,GMRAIEN,14,IDMNUM))
I IDMNUM<1!(IDMNUM>IDMLIM) G CHM
S GMRAIDB=$P($G(^GMR(120.8,GMRAIEN,14,IDMNUM,0)),U,1)
S STRING="i"_GMRAIDB D NEXT G IDBLOOP
CHM S STRING="~CHART MARKED" D NEXT
S CHMNOD=$G(^GMR(120.8,GMRAIEN,13,0)),CHMLIM=$P(CHMNOD,U,3),CHMNUM=0
I CHMLIM<1 G VER
CHMLOOP S CHMNUM=$O(^GMR(120.8,GMRAIEN,13,CHMNUM))
I CHMNUM<1!(CHMNUM>CHMLIM) G VER
S GMRACHM=$P($G(^GMR(120.8,GMRAIEN,13,CHMNUM,0)),U,1)
S STRING="i"_GMRACHM D NEXT G CHMLOOP
VER S STRING="~VERIFIER" D NEXT
S GMRAVDUZ=$P(GMRA(0),U,18) I GMRAVDUZ<1 G VFD
S STRING="d"_GMRAVDUZ_"^"_$$GET1^DIQ(200,GMRAVDUZ_",",".01") D NEXT
VFD S STRING="~VERIFIED" D NEXT
S GMRAVYN=$P(GMRA(0),U,16)
S STRING="d"_$S(GMRAVYN=1:"YES",1:"NO")_"^"_$P(GMRA(0),U,17) D NEXT
ERR S STRING="~ENTERED IN ERROR" D NEXT
S STRING="d"_$S(+$G(^GMR(120.8,GMRAIEN,"ER"))=1:"YES",1:"NO") D NEXT
OBSHIST S STRING="~OBS/HIST" D NEXT
S GMRAOBS=$P(GMRA(0),U,6)
S STRING="d"_GMRAOBS_"^"_$S(GMRAOBS="o":"OBSERVED",GMRAOBS="h":"HISTORICAL",1:"") D NEXT
I GMRAOBS'="o" G EXIT
D EN1^GMRAGUI1
EXIT Q
NEXT ;SET ARRAY NODE AND INCREMENT ARRAY COUNTER
S @GMRARRAY@(ND)=STRING,ND=ND+1,STRING=""
Q
GMRAGUI ;SLC/DAN - CPRS GUI support ;12/22/04 10:16
+1 ;;4.0;Adverse Reaction Tracking;**21**;Mar 29, 1996
+2 ;
GETREC(GMRAIEN,GMRARRAY) ;
+1 ;GMRAIEN = IEN of object record from file 120.8
+2 ;GMRARRAY = array specifier ie.^TMP($J,"ART")
+3 KILL @GMRARRAY
+4 NEW ND,STRING,SSNODE,GMRA,GMRACA,GMRAT,GMRANOR,SSLIM,SSNUM,GMRASSI,GMRASS,GMRADT,Y,GMRAODUZ,COMFLAG,COMNUM,I
+5 NEW COMMENTS,GMRACODT,GMRACDUZ,GMRACUS,PREFIX,COMLINE,IDMNOD,IDMLIM,IDMNUM,GMRAIDB,CHMNOD,CHMLIM,CHMNUM,GMRACHM,GMRAVDUZ,GMRAVYN,GMRAOBS,OBSIEN,USRNAM,USR,SEVCOD,SEVER
+6 SET ND=1
+7 IF '$DATA(GMRAIEN)!('+GMRAIEN)
QUIT
+8 SET GMRA(0)=$GET(^GMR(120.8,+GMRAIEN,0))
IF '$LENGTH(GMRA(0))
QUIT
+9 SET STRING="~CAUSATIVE AGENT"
DO NEXT
+10 SET GMRACA=$PIECE(GMRA(0),U,2)
+11 SET STRING="d"_GMRACA
DO NEXT
+12 SET STRING="~ALLERGY TYPE"
DO NEXT
+13 SET GMRAT=$PIECE(GMRA(0),U,20)
+14 SET STRING="d"_GMRAT_"^"_$TRANSLATE($$OUTTYPE^GMRAUTL(GMRAT)," ","")
DO NEXT
+15 SET STRING="~NATURE OF REACTION"
DO NEXT
+16 SET GMRANOR=$PIECE(GMRA(0),U,14)
+17 SET STRING="d"_GMRANOR_U_$SELECT(GMRANOR="A":"ALLERGY",GMRANOR="R":"ADVERSE REACTION",GMRANOR="P":"PHARMACOLOGICAL",1:"UNKNOWN")
DO NEXT
+18 SET STRING="~SIGN/SYMPTOMS"
DO NEXT
+19 SET SSNODE=$GET(^GMR(120.8,GMRAIEN,10,0))
SET SSLIM=$PIECE(SSNODE,U,3)
SET SSNUM=0
+20 IF SSLIM<1
GOTO ORIG
SSLOOP SET SSNUM=$ORDER(^GMR(120.8,GMRAIEN,10,SSNUM))
+1 IF SSNUM<1!(SSNUM>SSLIM)
GOTO ORIG
+2 SET GMRASSI=$PIECE($GET(^GMR(120.8,GMRAIEN,10,SSNUM,0)),U,1)
SET GMRASS=$PIECE($GET(^GMRD(120.83,GMRASSI,0)),U,1)
SET GMRADT=$PIECE($GET(^GMR(120.8,GMRAIEN,10,SSNUM,0)),U,4)
+3 SET Y=$$FMTE^XLFDT(GMRADT,"D")
+4 SET STRING="i"_GMRASSI_"^"_GMRASS_"^"_GMRADT_"^ "_Y
DO NEXT
GOTO SSLOOP
ORIG SET STRING="~ORIGINATOR"
DO NEXT
+1 SET GMRAODUZ=$PIECE(GMRA(0),U,5)
+2 SET STRING="d"_GMRAODUZ_"^"_$SELECT(GMRAODUZ:$$GET1^DIQ(200,GMRAODUZ_",",".01"),1:"")
DO NEXT
+3 SET STRING="~ORIGINATED"
DO NEXT
+4 SET STRING="d"_$PIECE(GMRA(0),U,4)
DO NEXT
+5 SET COMFLAG=0
SET COMNUM=0
+6 SET STRING="~COMMENTS"
DO NEXT
+7 SET COMMENTS=$GET(^GMR(120.8,GMRAIEN,26,0))
IF COMMENTS'=""
SET COMFLAG=1
CLOOP1 ;
IF COMFLAG
Begin DoDot:1
+1 SET COMNUM=$ORDER(^GMR(120.8,GMRAIEN,26,COMNUM))
+2 IF COMNUM<1
QUIT
+3 SET GMRACODT=$PIECE($GET(^GMR(120.8,GMRAIEN,26,COMNUM,0)),U,1)
+4 SET Y=$$FMTE^XLFDT(GMRACODT,"D")
+5 SET STRING="tComment Date: "_Y
+6 DO NEXT
+7 SET GMRACDUZ=$PIECE($GET(^GMR(120.8,GMRAIEN,26,COMNUM,0)),U,2)
SET GMRACUS=$SELECT('GMRACDUZ:"",1:$$GET1^DIQ(200,GMRACDUZ_",",".01"))
+8 SET STRING="tEntered By : "_GMRACUS
+9 DO NEXT
+10 SET PREFIX="tComments : "
+11 SET COMLINE=$ORDER(^GMR(120.8,GMRAIEN,26,COMNUM,2,0))
CLOOP2 ;
IF COMLINE
Begin DoDot:2
+1 SET STRING=PREFIX_$GET(^GMR(120.8,GMRAIEN,26,COMNUM,2,COMLINE,0))
DO NEXT
+2 SET PREFIX="t "
End DoDot:2
+3 SET COMLINE=$ORDER(^GMR(120.8,GMRAIEN,26,COMNUM,2,COMLINE))
+4 IF COMLINE>0
GOTO CLOOP2
+5 SET STRING="t"
+6 FOR I=1:1:60
SET STRING=STRING_"-"
+7 DO NEXT
End DoDot:1
+8 IF COMNUM>0
GOTO CLOOP1
IDBM SET STRING="~ID BAND MARKED"
DO NEXT
+1 SET IDMNOD=$GET(^GMR(120.8,GMRAIEN,14,0))
SET IDMLIM=$PIECE(IDMNOD,U,3)
SET IDMNUM=0
+2 IF IDMLIM<1
GOTO CHM
IDBLOOP SET IDMNUM=$ORDER(^GMR(120.8,GMRAIEN,14,IDMNUM))
+1 IF IDMNUM<1!(IDMNUM>IDMLIM)
GOTO CHM
+2 SET GMRAIDB=$PIECE($GET(^GMR(120.8,GMRAIEN,14,IDMNUM,0)),U,1)
+3 SET STRING="i"_GMRAIDB
DO NEXT
GOTO IDBLOOP
CHM SET STRING="~CHART MARKED"
DO NEXT
+1 SET CHMNOD=$GET(^GMR(120.8,GMRAIEN,13,0))
SET CHMLIM=$PIECE(CHMNOD,U,3)
SET CHMNUM=0
+2 IF CHMLIM<1
GOTO VER
CHMLOOP SET CHMNUM=$ORDER(^GMR(120.8,GMRAIEN,13,CHMNUM))
+1 IF CHMNUM<1!(CHMNUM>CHMLIM)
GOTO VER
+2 SET GMRACHM=$PIECE($GET(^GMR(120.8,GMRAIEN,13,CHMNUM,0)),U,1)
+3 SET STRING="i"_GMRACHM
DO NEXT
GOTO CHMLOOP
VER SET STRING="~VERIFIER"
DO NEXT
+1 SET GMRAVDUZ=$PIECE(GMRA(0),U,18)
IF GMRAVDUZ<1
GOTO VFD
+2 SET STRING="d"_GMRAVDUZ_"^"_$$GET1^DIQ(200,GMRAVDUZ_",",".01")
DO NEXT
VFD SET STRING="~VERIFIED"
DO NEXT
+1 SET GMRAVYN=$PIECE(GMRA(0),U,16)
+2 SET STRING="d"_$SELECT(GMRAVYN=1:"YES",1:"NO")_"^"_$PIECE(GMRA(0),U,17)
DO NEXT
ERR SET STRING="~ENTERED IN ERROR"
DO NEXT
+1 SET STRING="d"_$SELECT(+$GET(^GMR(120.8,GMRAIEN,"ER"))=1:"YES",1:"NO")
DO NEXT
OBSHIST SET STRING="~OBS/HIST"
DO NEXT
+1 SET GMRAOBS=$PIECE(GMRA(0),U,6)
+2 SET STRING="d"_GMRAOBS_"^"_$SELECT(GMRAOBS="o":"OBSERVED",GMRAOBS="h":"HISTORICAL",1:"")
DO NEXT
+3 IF GMRAOBS'="o"
GOTO EXIT
+4 DO EN1^GMRAGUI1
EXIT QUIT
NEXT ;SET ARRAY NODE AND INCREMENT ARRAY COUNTER
+1 SET @GMRARRAY@(ND)=STRING
SET ND=ND+1
SET STRING=""
+2 QUIT
