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