GMRAMCB1 ;HIRMFO/WAA-MARK CHART & ID BAND FIELD EDIT PART 2 ;7/23/97 09:39
;;4.0;Adverse Reaction Tracking;**8**;Mar 29, 1996
GETAL ; GET PATIENT AND ALLERGY
S GMRANS="",DFN=-1,DIC="^DPT(",DIC(0)="AEQM",DIC("A")="Select Patient: " D ^DIC Q:+Y'>0 K DIC,DLAYGO S DFN=+Y
L +^GMR(120.8,"B",DFN):0 I '$T W !,"THIS DATA IS CURRENTLY BEING EDITED, TRY LATER." G GETAL
D DEM^VADPT S GMRANAM=VADM(1) D INP^VADPT S:'+VAIN(4) GMRALOC="" I +VAIN(4) S GMRAHLOC=+$G(^DIC(42,+VAIN(4),44)),GMRALOC=$P(VAIN(4),U,2)
D PID^VADPT6 S GMRAVIP=VA("PID") D KVAR^VADPT K VA
D HLP12085^GMRAU851(DFN,"'+$G(^GMR(120.8,+GMRAX,""ER""))") Q:GMRAOUT
K GMRAX,GMRALL
ALL1 W ! S GMRADEL=0
K DIR S DIR(0)="FAO^1:60",DIR("A")="Select "_$S('$D(GMRALL):"CAUSATIVE AGENT: ",1:"another CAUSATIVE AGENT: ")
S DIR("?",1)=" ENTER THE CAUSATIVE AGENT YOU WISH TO INDICATE HAS"
S DIR("?",2)=" HAD ITS ID BAND OR CHART MARKED.",DIR("?")=" ENTER ?? TO SEE LIST OF ALL CAUSATIVE AGENT YOU HAVE SELECTED OR CAN SELECT.",DIR("??")="^D HELP^GMRAMCB"
D ^DIR K DIR
I $D(DTOUT)!($D(DUOUT))!($D(DIROUT)) K X,Y S GMRAOUT=1 Q
Q:Y="" S X=Y K Y I $$UP^XLFSTR(X)="ALL" D ALLSEL Q:GMRAOUT G:'$D(X) ALL1
I X["-" S GMRADEL=1,X=$P(X,"-",2)
S GMRAX=X,X=$P($G(^DPT(DFN,0)),"^")
K DIC S DIC="^GMR(120.8,",DIC(0)="EZQ",DIC("W")="W "" "",$P($G(^(0)),U,2)"
S DIC("S")="I $P(^(0),U)=DFN,$P($$UP^XLFSTR($P(^(0),U,2)),$$UP^XLFSTR(GMRAX))="""",$P(^(0),U,2)'="""",'+$G(^GMR(120.8,+Y,""ER""))"
D ^DIC K DIC I Y<1 G ALL1
S GMRAPA=+Y,GMRAPA(0)=$S($D(^GMR(120.8,GMRAPA,0)):^(0),1:"")
I GMRAPA(0)="" S GMRADEL=0 G ALL1
I GMRADEL D G ALL1
.I '$D(GMRALL(GMRAPA)) W !," YOU HAVE NOT SELECTED THAT CAUSATIVE AGENT." S GMRADEL=0 Q
.K GMRALL(GMRAPA) S GMRADEL=0
.Q
I $D(GMRALL(GMRAPA)) W !," YOU HAVE ALREADY SELECTED THAT CAUSATIVE AGENT",$C(7) G ALL1
S GMRALL(GMRAPA)="" G ALL1
ALLSEL ;THIS WILL ALLOW THE USER TO SELECT ALL ALLERGY
S GMRATMP=X F S %=1 W !,"Do you want to select all the patient's CAUSATIVE AGENTS" D YN^DICN S:%<0 %=2,GMRAOUT=1 Q:% W !?4,"ENTER YES OR NO IF YOU WANT ALL THE PATIENT'S CAUSATIVE AGENTS"
S X=GMRATMP K GMRATMP Q:%'=1 S X=0 F S X=$O(^GMR(120.8,"B",DFN,X)) Q:X<1 D
.Q:$D(^GMR(120.8,X,"ER")) Q:$P(^GMR(120.8,X,0),U,2)=""
.S GMRALL(X)="" Q
K X
Q
SCREEN W !,"Press <CR> to continue or ^ to stop: " R GMRANS:DTIME S:'$T GMRANS="^^" I "^^"'[GMRANS W !?4,$C(7),"ENTER <CR> TO CONTINUE LISTING OR ^ TO EXIT LISTING" G SCREEN
D FF Q
FF ;
W #
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRAMCB1 2481 printed Apr 09, 2024@20:45:15 Page 2
GMRAMCB1 ;HIRMFO/WAA-MARK CHART & ID BAND FIELD EDIT PART 2 ;7/23/97 09:39
+1 ;;4.0;Adverse Reaction Tracking;**8**;Mar 29, 1996
GETAL ; GET PATIENT AND ALLERGY
+1 SET GMRANS=""
SET DFN=-1
SET DIC="^DPT("
SET DIC(0)="AEQM"
SET DIC("A")="Select Patient: "
DO ^DIC
if +Y'>0
QUIT
KILL DIC,DLAYGO
SET DFN=+Y
+2 LOCK +^GMR(120.8,"B",DFN):0
IF '$TEST
WRITE !,"THIS DATA IS CURRENTLY BEING EDITED, TRY LATER."
GOTO GETAL
+3 DO DEM^VADPT
SET GMRANAM=VADM(1)
DO INP^VADPT
if '+VAIN(4)
SET GMRALOC=""
IF +VAIN(4)
SET GMRAHLOC=+$GET(^DIC(42,+VAIN(4),44))
SET GMRALOC=$PIECE(VAIN(4),U,2)
+4 DO PID^VADPT6
SET GMRAVIP=VA("PID")
DO KVAR^VADPT
KILL VA
+5 DO HLP12085^GMRAU851(DFN,"'+$G(^GMR(120.8,+GMRAX,""ER""))")
if GMRAOUT
QUIT
+6 KILL GMRAX,GMRALL
ALL1 WRITE !
SET GMRADEL=0
+1 KILL DIR
SET DIR(0)="FAO^1:60"
SET DIR("A")="Select "_$SELECT('$DATA(GMRALL):"CAUSATIVE AGENT: ",1:"another CAUSATIVE AGENT: ")
+2 SET DIR("?",1)=" ENTER THE CAUSATIVE AGENT YOU WISH TO INDICATE HAS"
+3 SET DIR("?",2)=" HAD ITS ID BAND OR CHART MARKED."
SET DIR("?")=" ENTER ?? TO SEE LIST OF ALL CAUSATIVE AGENT YOU HAVE SELECTED OR CAN SELECT."
SET DIR("??")="^D HELP^GMRAMCB"
+4 DO ^DIR
KILL DIR
+5 IF $DATA(DTOUT)!($DATA(DUOUT))!($DATA(DIROUT))
KILL X,Y
SET GMRAOUT=1
QUIT
+6 if Y=""
QUIT
SET X=Y
KILL Y
IF $$UP^XLFSTR(X)="ALL"
DO ALLSEL
if GMRAOUT
QUIT
if '$DATA(X)
GOTO ALL1
+7 IF X["-"
SET GMRADEL=1
SET X=$PIECE(X,"-",2)
+8 SET GMRAX=X
SET X=$PIECE($GET(^DPT(DFN,0)),"^")
+9 KILL DIC
SET DIC="^GMR(120.8,"
SET DIC(0)="EZQ"
SET DIC("W")="W "" "",$P($G(^(0)),U,2)"
+10 SET DIC("S")="I $P(^(0),U)=DFN,$P($$UP^XLFSTR($P(^(0),U,2)),$$UP^XLFSTR(GMRAX))="""",$P(^(0),U,2)'="""",'+$G(^GMR(120.8,+Y,""ER""))"
+11 DO ^DIC
KILL DIC
IF Y<1
GOTO ALL1
+12 SET GMRAPA=+Y
SET GMRAPA(0)=$SELECT($DATA(^GMR(120.8,GMRAPA,0)):^(0),1:"")
+13 IF GMRAPA(0)=""
SET GMRADEL=0
GOTO ALL1
+14 IF GMRADEL
Begin DoDot:1
+15 IF '$DATA(GMRALL(GMRAPA))
WRITE !," YOU HAVE NOT SELECTED THAT CAUSATIVE AGENT."
SET GMRADEL=0
QUIT
+16 KILL GMRALL(GMRAPA)
SET GMRADEL=0
+17 QUIT
End DoDot:1
GOTO ALL1
+18 IF $DATA(GMRALL(GMRAPA))
WRITE !," YOU HAVE ALREADY SELECTED THAT CAUSATIVE AGENT",$CHAR(7)
GOTO ALL1
+19 SET GMRALL(GMRAPA)=""
GOTO ALL1
ALLSEL ;THIS WILL ALLOW THE USER TO SELECT ALL ALLERGY
+1 SET GMRATMP=X
FOR
SET %=1
WRITE !,"Do you want to select all the patient's CAUSATIVE AGENTS"
DO YN^DICN
if %<0
SET %=2
SET GMRAOUT=1
if %
QUIT
WRITE !?4,"ENTER YES OR NO IF YOU WANT ALL THE PATIENT'S CAUSATIVE AGENTS"
+2 SET X=GMRATMP
KILL GMRATMP
if %'=1
QUIT
SET X=0
FOR
SET X=$ORDER(^GMR(120.8,"B",DFN,X))
if X<1
QUIT
Begin DoDot:1
+3 if $DATA(^GMR(120.8,X,"ER"))
QUIT
if $PIECE(^GMR(120.8,X,0),U,2)=""
QUIT
+4 SET GMRALL(X)=""
QUIT
End DoDot:1
+5 KILL X
+6 QUIT
SCREEN WRITE !,"Press <CR> to continue or ^ to stop: "
READ GMRANS:DTIME
if '$TEST
SET GMRANS="^^"
IF "^^"'[GMRANS
WRITE !?4,$CHAR(7),"ENTER <CR> TO CONTINUE LISTING OR ^ TO EXIT LISTING"
GOTO SCREEN
+1 DO FF
QUIT
FF ;
+1 WRITE #
+2 QUIT
