GMRAPEM1 ; HIRMFO/YMP,RM,WAA - CHANGE OF OBSERVED DATA TO HISTORICAL STORAGE ;May 11, 2021@12:03:03
;;4.0;Adverse Reaction Tracking;**63**;Mar 29, 1996;Build 34
ENDING ;Display and edit the word processing field for a patient reaction.
W @IOF,! D DISP,EDIT G EXIT
Q
OUTPUT ;Display the word processing field for a patient.
D DISP G EXIT
Q
DISP S GMRAOUT=0
F GMRAYY="O","V","E" D DISP1(GMRAPA,GMRAYY,.GMRAOUT) Q:GMRAOUT
Q
DISP1(GMRAPA,GMRAKIND,GMRAOUT) ;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
; GMRAOUT = Escape variable
I '$D(^GMR(120.8,GMRAPA,26,"AVER",GMRAKIND)) Q
W !!,?5,$S(GMRAKIND="O":"ORIGINATOR",GMRAKIND="V":"VERIFIER",GMRAKIND="E":"ENTERED IN ERROR",1:"")
W !,?6,"COMMENTS:"
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 PRINT
.Q
Q
PRINT ;PRINT OUT THE DATA
N GMRAT,GMRAZN S (GMRAZN,GMRAT)=""
S:GMRAZ'="" GMRAZN=$P($G(^VA(200,GMRAZ,0)),U)
S:GMRAZ'="" GMRAT=$P($G(^VA(200,GMRAZ,0)),U,9)
S:GMRAT'="" GMRAT=$P($G(^DIC(3.1,GMRAT,0)),U)
W !,?10,"Date: ",$$FMTE^XLFDT(GMRAY,1),?52,"User: ",GMRAZN
W !,?51,"Title: ",GMRAT
I '$D(^GMR(120.8,GMRAPA,26,GMRAX,2,0)) Q
S DIWL=16,DIWR=75,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
S GMRAXX=0 F S GMRAXX=$O(^UTILITY($J,"W",DIWL,GMRAXX)) Q:GMRAXX<1 D:($Y+3)>IOSL HEAD Q:GMRAOUT W !,?16,^UTILITY($J,"W",DIWL,GMRAXX,0)
W !
Q
HEAD ;print a header
D EOP^GMRADSP3
Q
EDIT ;Edit the word processing field.
Q:GMRAOUT=2 S:'$D(GMRAVCM) GMRAVCM="O"
S GMRAOUT=0 N GMRA
I '$D(^GMR(120.8,GMRAPA,26,0)) S ^(0)="^120.826D^^"
D NOW^%DTC S DIC="^GMR(120.8,"_GMRAPA_",26,",DA(1)=GMRAPA,DLAYGO=120.8,DIC(0)="L",X=% K DD,DO,DINUM D FILE^DICN K DLAYGO G EXIT:+Y'>0
K DR S DA=+Y,DIE=DIC,DR="1////"_DUZ_";1.5////"_GMRAVCM_";2" K DIC D ^DIE
I '$O(^GMR(120.8,DA(1),26,DA,2,0)) S DIK=DIE D ^DIK K Y
EXIT ;Exit point.
K GMRAVCM
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRAPEM1 2256 printed Dec 13, 2024@01:39:57 Page 2
GMRAPEM1 ; HIRMFO/YMP,RM,WAA - CHANGE OF OBSERVED DATA TO HISTORICAL STORAGE ;May 11, 2021@12:03:03
+1 ;;4.0;Adverse Reaction Tracking;**63**;Mar 29, 1996;Build 34
ENDING ;Display and edit the word processing field for a patient reaction.
+1 WRITE @IOF,!
DO DISP
DO EDIT
GOTO EXIT
+2 QUIT
OUTPUT ;Display the word processing field for a patient.
+1 DO DISP
GOTO EXIT
+2 QUIT
DISP SET GMRAOUT=0
+1 FOR GMRAYY="O","V","E"
DO DISP1(GMRAPA,GMRAYY,.GMRAOUT)
if GMRAOUT
QUIT
+2 QUIT
DISP1(GMRAPA,GMRAKIND,GMRAOUT) ;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 ; GMRAOUT = Escape variable
+8 IF '$DATA(^GMR(120.8,GMRAPA,26,"AVER",GMRAKIND))
QUIT
+9 WRITE !!,?5,$SELECT(GMRAKIND="O":"ORIGINATOR",GMRAKIND="V":"VERIFIER",GMRAKIND="E":"ENTERED IN ERROR",1:"")
+10 WRITE !,?6,"COMMENTS:"
+11 SET GMRAX=0
FOR
SET GMRAX=$ORDER(^GMR(120.8,GMRAPA,26,"AVER",GMRAKIND,GMRAX))
if GMRAX<1
QUIT
Begin DoDot:1
+12 SET GMRAY=$PIECE(^GMR(120.8,GMRAPA,26,GMRAX,0),U)
SET GMRAZ=$PIECE(^(0),U,2)
+13 DO PRINT
+14 QUIT
End DoDot:1
if GMRAOUT
QUIT
+15 QUIT
PRINT ;PRINT OUT THE DATA
+1 NEW GMRAT,GMRAZN
SET (GMRAZN,GMRAT)=""
+2 if GMRAZ'=""
SET GMRAZN=$PIECE($GET(^VA(200,GMRAZ,0)),U)
+3 if GMRAZ'=""
SET GMRAT=$PIECE($GET(^VA(200,GMRAZ,0)),U,9)
+4 if GMRAT'=""
SET GMRAT=$PIECE($GET(^DIC(3.1,GMRAT,0)),U)
+5 WRITE !,?10,"Date: ",$$FMTE^XLFDT(GMRAY,1),?52,"User: ",GMRAZN
+6 WRITE !,?51,"Title: ",GMRAT
+7 IF '$DATA(^GMR(120.8,GMRAPA,26,GMRAX,2,0))
QUIT
+8 SET DIWL=16
SET DIWR=75
SET DIWF=""
+9 KILL ^UTILITY($JOB,"W",DIWL)
+10 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
+11 SET GMRAXX=0
FOR
SET GMRAXX=$ORDER(^UTILITY($JOB,"W",DIWL,GMRAXX))
if GMRAXX<1
QUIT
if ($Y+3)>IOSL
DO HEAD
if GMRAOUT
QUIT
WRITE !,?16,^UTILITY($JOB,"W",DIWL,GMRAXX,0)
+12 WRITE !
+13 QUIT
HEAD ;print a header
+1 DO EOP^GMRADSP3
+2 QUIT
EDIT ;Edit the word processing field.
+1 if GMRAOUT=2
QUIT
if '$DATA(GMRAVCM)
SET GMRAVCM="O"
+2 SET GMRAOUT=0
NEW GMRA
+3 IF '$DATA(^GMR(120.8,GMRAPA,26,0))
SET ^(0)="^120.826D^^"
+4 DO NOW^%DTC
SET DIC="^GMR(120.8,"_GMRAPA_",26,"
SET DA(1)=GMRAPA
SET DLAYGO=120.8
SET DIC(0)="L"
SET X=%
KILL DD,DO,DINUM
DO FILE^DICN
KILL DLAYGO
if +Y'>0
GOTO EXIT
+5 KILL DR
SET DA=+Y
SET DIE=DIC
SET DR="1////"_DUZ_";1.5////"_GMRAVCM_";2"
KILL DIC
DO ^DIE
+6 IF '$ORDER(^GMR(120.8,DA(1),26,DA,2,0))
SET DIK=DIE
DO ^DIK
KILL Y
EXIT ;Exit point.
+1 KILL GMRAVCM
+2 QUIT
