GMRAWORD ;HIRMFO/YMP,RM,WAA- WORD DATA TO HISTORICAL STORAGE ;12/1/95 13:45
;;4.0;Adverse Reaction Tracking;;Mar 29, 1996
WORD(GMRAPA,COMM,WID) ; PASS THE DATA TO AN ARRAY
; Input variables:
; GMRAPA = Reaction IEN in 120.8
; COMM = Kind of comment to display
; O is Originator
; V is Verifier
; E is Entered in Error
; ARRAY = Merge arrat for the text
; WID = Width of the array
N GMRAYY,GMRACNT,Y,DIWL
S GMRACNT=1
F GMRAYY=1:1:$L(COMM) K ^UTILITY($J,"W") D
.D DISP1(GMRAPA,$E(COMM,GMRAYY),WID) Q:'$D(DIWL)
.I $D(^UTILITY($J,"W",DIWL)) S ^TMP($J,"GMRAWORD",GMRACNT)=$S($E(COMM,GMRAYY)="E":"ENTERED IN ERROR",$E(COMM,GMRAYY)="V":"VERIFIER",$E(COMM,GMRAYY)="O":"OBSERVER",1:"")_" COMMENTS: ",GMRACNT=GMRACNT+1
.S Y=0 F S Y=$O(^UTILITY($J,"W",DIWL,Y)) Q:Y<1 S ^TMP($J,"GMRAWORD",GMRACNT)=$G(^UTILITY($J,"W",DIWL,Y,0)),GMRACNT=GMRACNT+1
.Q
Q
DISP1(GMRAPA,GMRAKIND,WID) ;Display comments and reaction for a reaction
; Input variables:
; GMRAPA = Reaction IEN in 120.8
; GMRAKIND = Kind of comment to display
; O is Originator
; V is Verifier
; E is Entered in Error
; WID = Width of the array
I '$D(^GMR(120.8,GMRAPA,26,"AVER",GMRAKIND)) Q
S GMRAX=0 F S GMRAX=$O(^GMR(120.8,GMRAPA,26,"AVER",GMRAKIND,GMRAX)) Q:GMRAX<1 D Q:GMRAOUT
.S GMRAY=$P(^GMR(120.8,GMRAPA,26,GMRAX,0),U),GMRAZ=$P(^(0),U,2)
.D BLD
.Q
Q
BLD ; BUILD THE DATA
N GMRAT,GMRAZN S (GMRAZN,GMRAT)=""
I '$D(^GMR(120.8,GMRAPA,26,GMRAX,2,0)) Q
S DIWL=0,DIWR=WID,DIWF=""
K ^UTILITY($J,"W",DIWL)
S GMRAXX=0 F S GMRAXX=$O(^GMR(120.8,GMRAPA,26,GMRAX,2,GMRAXX)) Q:GMRAXX<1 S X=^(GMRAXX,0) D ^DIWP
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRAWORD 1746 printed Oct 16, 2024@17:41:38 Page 2
GMRAWORD ;HIRMFO/YMP,RM,WAA- WORD DATA TO HISTORICAL STORAGE ;12/1/95 13:45
+1 ;;4.0;Adverse Reaction Tracking;;Mar 29, 1996
WORD(GMRAPA,COMM,WID) ; PASS THE DATA TO AN ARRAY
+1 ; Input variables:
+2 ; GMRAPA = Reaction IEN in 120.8
+3 ; COMM = Kind of comment to display
+4 ; O is Originator
+5 ; V is Verifier
+6 ; E is Entered in Error
+7 ; ARRAY = Merge arrat for the text
+8 ; WID = Width of the array
+9 NEW GMRAYY,GMRACNT,Y,DIWL
+10 SET GMRACNT=1
+11 FOR GMRAYY=1:1:$LENGTH(COMM)
KILL ^UTILITY($JOB,"W")
Begin DoDot:1
+12 DO DISP1(GMRAPA,$EXTRACT(COMM,GMRAYY),WID)
if '$DATA(DIWL)
QUIT
+13 IF $DATA(^UTILITY($JOB,"W",DIWL))
SET ^TMP($JOB,"GMRAWORD",GMRACNT)=$SELECT($EXTRACT(COMM,GMRAYY)="E":"ENTERED IN ERROR",$EXTRACT(COMM,GMRAYY)="V":"VERIFIER",$EXTRACT(COMM,GMRAYY)="O":"OBSERVER",1:"")_" COMMENTS: "
SET GMRACNT=GMRACNT+1
+14 SET Y=0
FOR
SET Y=$ORDER(^UTILITY($JOB,"W",DIWL,Y))
if Y<1
QUIT
SET ^TMP($JOB,"GMRAWORD",GMRACNT)=$GET(^UTILITY($JOB,"W",DIWL,Y,0))
SET GMRACNT=GMRACNT+1
+15 QUIT
End DoDot:1
+16 QUIT
DISP1(GMRAPA,GMRAKIND,WID) ;Display comments and reaction for a reaction
+1 ; Input variables:
+2 ; GMRAPA = Reaction IEN in 120.8
+3 ; GMRAKIND = Kind of comment to display
+4 ; O is Originator
+5 ; V is Verifier
+6 ; E is Entered in Error
+7 ; WID = Width of the array
+8 IF '$DATA(^GMR(120.8,GMRAPA,26,"AVER",GMRAKIND))
QUIT
+9 SET GMRAX=0
FOR
SET GMRAX=$ORDER(^GMR(120.8,GMRAPA,26,"AVER",GMRAKIND,GMRAX))
if GMRAX<1
QUIT
Begin DoDot:1
+10 SET GMRAY=$PIECE(^GMR(120.8,GMRAPA,26,GMRAX,0),U)
SET GMRAZ=$PIECE(^(0),U,2)
+11 DO BLD
+12 QUIT
End DoDot:1
if GMRAOUT
QUIT
+13 QUIT
BLD ; BUILD THE DATA
+1 NEW GMRAT,GMRAZN
SET (GMRAZN,GMRAT)=""
+2 IF '$DATA(^GMR(120.8,GMRAPA,26,GMRAX,2,0))
QUIT
+3 SET DIWL=0
SET DIWR=WID
SET DIWF=""
+4 KILL ^UTILITY($JOB,"W",DIWL)
+5 SET GMRAXX=0
FOR
SET GMRAXX=$ORDER(^GMR(120.8,GMRAPA,26,GMRAX,2,GMRAXX))
if GMRAXX<1
QUIT
SET X=^(GMRAXX,0)
DO ^DIWP
+6 QUIT
