GMRAPHR2 ;HIRMFO/WAA,FT-ADD/DELETE/EDIT SUSPECT DRUGS ;9/11/96 10:49
;;4.0;Adverse Reaction Tracking;**5**;Mar 29, 1996
EN1 ;
Q:GMRAOUT
W @IOF N DIE,DA,GMRAXXX,GMRAX,GMRAGHC
K ^UTILITY("PSG",$J),^UTILITY("PSIV",$J),GMRARRAY
S GMRADT=$P(^GMR(120.85,GMRAPA1,0),U)
D ^GMRADSP7 G:'GMRAPA EXIT
SELECT W ! D LST
;SELECT ACTION
K DIR S DIR(0)="SOBA^A:ADD;D:DELETE;E:EDIT",DIR("A")="Select Action (A/D/E): "
S DIR("?")="ENTER A TO ADD A NEW DRUG, D TO DELETE A DRUG OR E TO EDIT"
D ^DIR K DIR I "^^"[Y S GMRAOUT=$L(Y) G EXIT
S GMRASEL=Y
I GMRASEL="A" S GMRALOOK=0 W ! D ADD K GMRALOOK G:GMRAOUT EXIT K GMRALOOK G SELECT
I GMRASEL="D" W ! D DEL G:GMRAOUT EXIT G SELECT
I GMRASEL="E" W ! D EDIT G:GMRAOUT EXIT G SELECT
G SELECT
EDIT ;EDIT A DRUG
I '$O(^GMR(120.85,GMRAPA1,3,0)) W !,?3,"YOU CANNOT EDIT WHEN THERE IS NO DATA ON FILE.",$C(7) Q
EDITLST ; DISPLAY TO EDIT FIELD
W !,"Select the DRUG RX you want to edit:",!
D LST
EEDT K DA,DO,DIC,DIE,DLAYGO,DR
S DA(1)=GMRAPA1,DIC="^GMR(120.85,"_DA(1)_",3,",DIC(0)="AMQEZ" D ^DIC K DIC
I $D(DUOUT)!($D(DTOUT))!(Y=-1) S GMRAOUT=1 G QE
S GMRASUS=+Y
S DA(1)=GMRAPA1,DIE="^GMR(120.85,"_DA(1)_",3,",DA=+Y,DR=".01;1;1.5;2;3;4;S X=X;5;S X=X;6;7;8;9;10;10.1;10.2" D ^DIE
I $D(DUOUT)!($D(DTOUT))!('$D(DA))!($D(Y)) G QE
K GMRAX,DA,DIE,DR,DIC,DLAYGO D EN1^GMRAPEL0
QE K GMRAX,DA,DIE,DR,DIC,DLAYGO,GMRASUS
Q
ADD ;SELECTION OF A DRUG OR ENTER A NEW DRUG
D DISP^GMRAPHR0 I GMRAOUT S GMRAOUT=GMRAOUT-1 Q:GMRAOUT
K % I '$D(GMRARRAY) D ADD2 S GMRAOUT=GMRAOUT-1 Q:GMRAOUT!(X="")!($D(Y)) G ADD
ADDED W !,"Enter the number(s) of the RX/DRUG to ADD or ""N"" for NEW: "
R GMRAX:DTIME S:'$T GMRAX="^^" I "^^"[GMRAX S GMRAOUT=$L(GMRAX) Q
I "??"[GMRAX W !,"ENTER THE NUMBER(S) OF THE ENTRY YOU WANT OR ""N"" FOR A NEW DRUG" G:$L(GMRAX)=1 ADDED G ADD
I GMRAX="n" S GMRAX="N"
I GMRAX="N" D ADD2 Q:X="" G ADD
I '$$VALST(GMRAX,"PH") W !,$C(7),"INVALID SELECTION PLEASE SELECT ONE OF THE DRUGS LISTED OR ""N"" FOR A NEW DRUG" G ADD
S GMRALST=0 F S GMRALST=$O(GMRALST(GMRALST)) Q:GMRALST<1 S GMRAX=GMRALST D Q:GMRAOUT
.S X=$P(GMRARRAY("PH",GMRAX),U,2)
.I $D(^GMR(120.85,GMRAPA1,3,"B",X)) D Q:GMRAOUT!(%-1) K %
..W !,"You already have a ",X," DRUG on file."
..S %=2 F W !,"Do You still want to add this one" D YN^DICN S:%=-1 %=2,GMRAOUT=1 Q:% W !,"ENTER YES TO ADD THE DRUG or NO TO SELECT ANOTHER"
..Q
.K DD,DO
.I '$O(^GMR(120.85,GMRAPA1,3,0)) S ^(0)="^120.8503^^"
.S DA(1)=GMRAPA1,DIC="^GMR(120.85,"_GMRAPA1_",3,",DIC(0)="L",DLAYGO=120.85 D FILE^DICN
.I $G(DTOUT,0)!($G(DUOUT)) K DIC,DTOUT,DUOUT S GMRAOUT=1 Q
.Q:(+Y<1)
.S DA=+Y,DIE=DIC K DIC
.I $P(GMRARRAY("PH",GMRAX),U)="OP" S DR="1.5////"_$E($P(GMRARRAY("PH",GMRAX),U,3),1,30)_";10////"_$P(GMRARRAY("PH",GMRAX),U,4)
.I $P(GMRARRAY("PH",GMRAX),U)="D" D
..S DR="1////"_$P(GMRARRAY("PH",GMRAX),U,3)_";2////"_$P(GMRARRAY("PH",GMRAX),U,4)
..S DR=DR_";4////"_$P(GMRARRAY("PH",GMRAX),U,6)_";5////"_$P(GMRARRAY("PH",GMRAX),U,7)
..Q
.I $P(GMRARRAY("PH",GMRAX),U)="IV" D
..S DR="1////"_$P(GMRARRAY("PH",GMRAX),U,3)_";2////IV"
..S DR=DR_";4////"_$P(GMRARRAY("PH",GMRAX),U,6)_";5////"_$P(GMRARRAY("PH",GMRAX),U,7)
..Q
.S GMRASUS=DA D ^DIE K DIE,DA,DR,GMRAX
.I '$D(DUOUT)!($D(DTOUT)) N X D EN1^GMRAPEL0
.K GMRASUS Q
Q
ADD2 ;
K DD,DO
I '$O(^GMR(120.85,GMRAPA1,3,0)) S ^(0)="^120.8503^^"
S $P(^GMR(120.85,GMRAPA1,3,0),"^",2)="120.8503O"
S DA(1)=GMRAPA1,DIC="^GMR(120.85,"_GMRAPA1_",3,",DIC(0)="AEMLQZ",DLAYGO=120.85 D ^DIC
S $P(^GMR(120.85,GMRAPA1,3,0),"^",2)="120.8503"
I $D(DUOUT)!$D(DTOUT) S GMRAOUT=1 I $D(DTOUT) S GMRAOUT=GMRAOUT+1
I GMRAOUT!(+Y<1) K DIC,DA Q
S DA=+Y K DIC
S DA(1)=GMRAPA1,DIE="^GMR(120.85,"_GMRAPA1_",3,",DLAYGO=120.85,DR="1:10.2" D ^DIE
I '$D(Y)!$G(DTOUT) S GMRAOUT=1 I $G(DTOUT) S GMRAOUT=GMRAOUT+1
S X=$P($G(^GMR(120.85,GMRAPA1,3,DA,0)),U,1)
I 'GMRAOUT N X S GMRASUS=DA D EN1^GMRAPEL0
K DA,DIE,DLAYGO,DR,GMRASUS
Q
DEL ;
I '$D(^GMR(120.85,GMRAPA1,3,0)) W !,"THERE ARE NO DRUG SELECTED FOR THIS PATIENT" Q
K DA,DO,DIC,DIE,DLAYGO,DR
S DA(1)=GMRAPA1,DIC="^GMR(120.85,"_DA(1)_",3,",DIC(0)="AMQEZ" D ^DIC
I $D(DUOUT)!($D(DTOUT))!(Y=-1) S GMRAOUT=1 G DQ
K DIC,DA,DO
S DA(1)=GMRAPA1,DIK="^GMR(120.85,"_DA(1)_",3,",DA=+Y D ^DIK
DQ K DIC,DIC,DA,DO,DLAYGO,DIK,Y
Q
LST I '$O(^GMR(120.85,GMRAPA1,3,0)) W !,"THIS PATIENT HAS NO SUSPECTED AGENTS ON FILE" Q
W !,"This patient has the following Drugs selected: ",!
S GMRAX=0 F GMRAXX=1:1 S GMRAX=$O(^GMR(120.85,GMRAPA1,3,GMRAX)) Q:GMRAX<1 W !,?10,$P(^(GMRAX,0),U)
Q
EXIT ;EXIT LINE
K DIR,Y,GMRASEL,GMRABGDT,GMRAENDT,^UTILITY("PSG",$J),^UTILITY("PSIV",$J),GMRARRAY
Q
VALST(LST,SUB) ; GIVEN LST, THIS FUNCTION RETURNS 1 IF LIST VALID, ELSE 0
N X,Y,Z,A
K GMRALST
S Z=1 F X=1:1:$L(LST,",") S Y=$P(LST,",",X) D Q:'Z
.I Y'?1N.N,Y'?1N.N1"-"1N.N S Z=0 Q
.I Y?1N.N S Y=Y_"-"_Y
.F A=$P(Y,"-"):1:$P(Y,"-",2) S:'$D(GMRARRAY(SUB,A)) Z=0 Q:'Z S GMRALST(A)=""
.Q
K:'Z GMRALST
Q Z
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRAPHR2 4981 printed Dec 13, 2024@01:40:12 Page 2
GMRAPHR2 ;HIRMFO/WAA,FT-ADD/DELETE/EDIT SUSPECT DRUGS ;9/11/96 10:49
+1 ;;4.0;Adverse Reaction Tracking;**5**;Mar 29, 1996
EN1 ;
+1 if GMRAOUT
QUIT
+2 WRITE @IOF
NEW DIE,DA,GMRAXXX,GMRAX,GMRAGHC
+3 KILL ^UTILITY("PSG",$JOB),^UTILITY("PSIV",$JOB),GMRARRAY
+4 SET GMRADT=$PIECE(^GMR(120.85,GMRAPA1,0),U)
+5 DO ^GMRADSP7
if 'GMRAPA
GOTO EXIT
SELECT WRITE !
DO LST
+1 ;SELECT ACTION
+2 KILL DIR
SET DIR(0)="SOBA^A:ADD;D:DELETE;E:EDIT"
SET DIR("A")="Select Action (A/D/E): "
+3 SET DIR("?")="ENTER A TO ADD A NEW DRUG, D TO DELETE A DRUG OR E TO EDIT"
+4 DO ^DIR
KILL DIR
IF "^^"[Y
SET GMRAOUT=$LENGTH(Y)
GOTO EXIT
+5 SET GMRASEL=Y
+6 IF GMRASEL="A"
SET GMRALOOK=0
WRITE !
DO ADD
KILL GMRALOOK
if GMRAOUT
GOTO EXIT
KILL GMRALOOK
GOTO SELECT
+7 IF GMRASEL="D"
WRITE !
DO DEL
if GMRAOUT
GOTO EXIT
GOTO SELECT
+8 IF GMRASEL="E"
WRITE !
DO EDIT
if GMRAOUT
GOTO EXIT
GOTO SELECT
+9 GOTO SELECT
EDIT ;EDIT A DRUG
+1 IF '$ORDER(^GMR(120.85,GMRAPA1,3,0))
WRITE !,?3,"YOU CANNOT EDIT WHEN THERE IS NO DATA ON FILE.",$CHAR(7)
QUIT
EDITLST ; DISPLAY TO EDIT FIELD
+1 WRITE !,"Select the DRUG RX you want to edit:",!
+2 DO LST
EEDT KILL DA,DO,DIC,DIE,DLAYGO,DR
+1 SET DA(1)=GMRAPA1
SET DIC="^GMR(120.85,"_DA(1)_",3,"
SET DIC(0)="AMQEZ"
DO ^DIC
KILL DIC
+2 IF $DATA(DUOUT)!($DATA(DTOUT))!(Y=-1)
SET GMRAOUT=1
GOTO QE
+3 SET GMRASUS=+Y
+4 SET DA(1)=GMRAPA1
SET DIE="^GMR(120.85,"_DA(1)_",3,"
SET DA=+Y
SET DR=".01;1;1.5;2;3;4;S X=X;5;S X=X;6;7;8;9;10;10.1;10.2"
DO ^DIE
+5 IF $DATA(DUOUT)!($DATA(DTOUT))!('$DATA(DA))!($DATA(Y))
GOTO QE
+6 KILL GMRAX,DA,DIE,DR,DIC,DLAYGO
DO EN1^GMRAPEL0
QE KILL GMRAX,DA,DIE,DR,DIC,DLAYGO,GMRASUS
+1 QUIT
ADD ;SELECTION OF A DRUG OR ENTER A NEW DRUG
+1 DO DISP^GMRAPHR0
IF GMRAOUT
SET GMRAOUT=GMRAOUT-1
if GMRAOUT
QUIT
+2 KILL %
IF '$DATA(GMRARRAY)
DO ADD2
SET GMRAOUT=GMRAOUT-1
if GMRAOUT!(X="")!($DATA(Y))
QUIT
GOTO ADD
ADDED WRITE !,"Enter the number(s) of the RX/DRUG to ADD or ""N"" for NEW: "
+1 READ GMRAX:DTIME
if '$TEST
SET GMRAX="^^"
IF "^^"[GMRAX
SET GMRAOUT=$LENGTH(GMRAX)
QUIT
+2 IF "??"[GMRAX
WRITE !,"ENTER THE NUMBER(S) OF THE ENTRY YOU WANT OR ""N"" FOR A NEW DRUG"
if $LENGTH(GMRAX)=1
GOTO ADDED
GOTO ADD
+3 IF GMRAX="n"
SET GMRAX="N"
+4 IF GMRAX="N"
DO ADD2
if X=""
QUIT
GOTO ADD
+5 IF '$$VALST(GMRAX,"PH")
WRITE !,$CHAR(7),"INVALID SELECTION PLEASE SELECT ONE OF THE DRUGS LISTED OR ""N"" FOR A NEW DRUG"
GOTO ADD
+6 SET GMRALST=0
FOR
SET GMRALST=$ORDER(GMRALST(GMRALST))
if GMRALST<1
QUIT
SET GMRAX=GMRALST
Begin DoDot:1
+7 SET X=$PIECE(GMRARRAY("PH",GMRAX),U,2)
+8 IF $DATA(^GMR(120.85,GMRAPA1,3,"B",X))
Begin DoDot:2
+9 WRITE !,"You already have a ",X," DRUG on file."
+10 SET %=2
FOR
WRITE !,"Do You still want to add this one"
DO YN^DICN
if %=-1
SET %=2
SET GMRAOUT=1
if %
QUIT
WRITE !,"ENTER YES TO ADD THE DRUG or NO TO SELECT ANOTHER"
+11 QUIT
End DoDot:2
if GMRAOUT!(%-1)
QUIT
KILL %
+12 KILL DD,DO
+13 IF '$ORDER(^GMR(120.85,GMRAPA1,3,0))
SET ^(0)="^120.8503^^"
+14 SET DA(1)=GMRAPA1
SET DIC="^GMR(120.85,"_GMRAPA1_",3,"
SET DIC(0)="L"
SET DLAYGO=120.85
DO FILE^DICN
+15 IF $GET(DTOUT,0)!($GET(DUOUT))
KILL DIC,DTOUT,DUOUT
SET GMRAOUT=1
QUIT
+16 if (+Y<1)
QUIT
+17 SET DA=+Y
SET DIE=DIC
KILL DIC
+18 IF $PIECE(GMRARRAY("PH",GMRAX),U)="OP"
SET DR="1.5////"_$EXTRACT($PIECE(GMRARRAY("PH",GMRAX),U,3),1,30)_";10////"_$PIECE(GMRARRAY("PH",GMRAX),U,4)
+19 IF $PIECE(GMRARRAY("PH",GMRAX),U)="D"
Begin DoDot:2
+20 SET DR="1////"_$PIECE(GMRARRAY("PH",GMRAX),U,3)_";2////"_$PIECE(GMRARRAY("PH",GMRAX),U,4)
+21 SET DR=DR_";4////"_$PIECE(GMRARRAY("PH",GMRAX),U,6)_";5////"_$PIECE(GMRARRAY("PH",GMRAX),U,7)
+22 QUIT
End DoDot:2
+23 IF $PIECE(GMRARRAY("PH",GMRAX),U)="IV"
Begin DoDot:2
+24 SET DR="1////"_$PIECE(GMRARRAY("PH",GMRAX),U,3)_";2////IV"
+25 SET DR=DR_";4////"_$PIECE(GMRARRAY("PH",GMRAX),U,6)_";5////"_$PIECE(GMRARRAY("PH",GMRAX),U,7)
+26 QUIT
End DoDot:2
+27 SET GMRASUS=DA
DO ^DIE
KILL DIE,DA,DR,GMRAX
+28 IF '$DATA(DUOUT)!($DATA(DTOUT))
NEW X
DO EN1^GMRAPEL0
+29 KILL GMRASUS
QUIT
End DoDot:1
if GMRAOUT
QUIT
+30 QUIT
ADD2 ;
+1 KILL DD,DO
+2 IF '$ORDER(^GMR(120.85,GMRAPA1,3,0))
SET ^(0)="^120.8503^^"
+3 SET $PIECE(^GMR(120.85,GMRAPA1,3,0),"^",2)="120.8503O"
+4 SET DA(1)=GMRAPA1
SET DIC="^GMR(120.85,"_GMRAPA1_",3,"
SET DIC(0)="AEMLQZ"
SET DLAYGO=120.85
DO ^DIC
+5 SET $PIECE(^GMR(120.85,GMRAPA1,3,0),"^",2)="120.8503"
+6 IF $DATA(DUOUT)!$DATA(DTOUT)
SET GMRAOUT=1
IF $DATA(DTOUT)
SET GMRAOUT=GMRAOUT+1
+7 IF GMRAOUT!(+Y<1)
KILL DIC,DA
QUIT
+8 SET DA=+Y
KILL DIC
+9 SET DA(1)=GMRAPA1
SET DIE="^GMR(120.85,"_GMRAPA1_",3,"
SET DLAYGO=120.85
SET DR="1:10.2"
DO ^DIE
+10 IF '$DATA(Y)!$GET(DTOUT)
SET GMRAOUT=1
IF $GET(DTOUT)
SET GMRAOUT=GMRAOUT+1
+11 SET X=$PIECE($GET(^GMR(120.85,GMRAPA1,3,DA,0)),U,1)
+12 IF 'GMRAOUT
NEW X
SET GMRASUS=DA
DO EN1^GMRAPEL0
+13 KILL DA,DIE,DLAYGO,DR,GMRASUS
+14 QUIT
DEL ;
+1 IF '$DATA(^GMR(120.85,GMRAPA1,3,0))
WRITE !,"THERE ARE NO DRUG SELECTED FOR THIS PATIENT"
QUIT
+2 KILL DA,DO,DIC,DIE,DLAYGO,DR
+3 SET DA(1)=GMRAPA1
SET DIC="^GMR(120.85,"_DA(1)_",3,"
SET DIC(0)="AMQEZ"
DO ^DIC
+4 IF $DATA(DUOUT)!($DATA(DTOUT))!(Y=-1)
SET GMRAOUT=1
GOTO DQ
+5 KILL DIC,DA,DO
+6 SET DA(1)=GMRAPA1
SET DIK="^GMR(120.85,"_DA(1)_",3,"
SET DA=+Y
DO ^DIK
DQ KILL DIC,DIC,DA,DO,DLAYGO,DIK,Y
+1 QUIT
LST IF '$ORDER(^GMR(120.85,GMRAPA1,3,0))
WRITE !,"THIS PATIENT HAS NO SUSPECTED AGENTS ON FILE"
QUIT
+1 WRITE !,"This patient has the following Drugs selected: ",!
+2 SET GMRAX=0
FOR GMRAXX=1:1
SET GMRAX=$ORDER(^GMR(120.85,GMRAPA1,3,GMRAX))
if GMRAX<1
QUIT
WRITE !,?10,$PIECE(^(GMRAX,0),U)
+3 QUIT
EXIT ;EXIT LINE
+1 KILL DIR,Y,GMRASEL,GMRABGDT,GMRAENDT,^UTILITY("PSG",$JOB),^UTILITY("PSIV",$JOB),GMRARRAY
+2 QUIT
VALST(LST,SUB) ; GIVEN LST, THIS FUNCTION RETURNS 1 IF LIST VALID, ELSE 0
+1 NEW X,Y,Z,A
+2 KILL GMRALST
+3 SET Z=1
FOR X=1:1:$LENGTH(LST,",")
SET Y=$PIECE(LST,",",X)
Begin DoDot:1
+4 IF Y'?1N.N
IF Y'?1N.N1"-"1N.N
SET Z=0
QUIT
+5 IF Y?1N.N
SET Y=Y_"-"_Y
+6 FOR A=$PIECE(Y,"-"):1:$PIECE(Y,"-",2)
if '$DATA(GMRARRAY(SUB,A))
SET Z=0
if 'Z
QUIT
SET GMRALST(A)=""
+7 QUIT
End DoDot:1
if 'Z
QUIT
+8 if 'Z
KILL GMRALST
+9 QUIT Z
