- 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 Jan 18, 2025@02:41:11 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