PSJALG ;BIR/UK-DETAILED ALLERGY LIST ;15 May 98 / 9:27 AM
;;5.0; INPATIENT MEDICATIONS ;**3,85**;16 DEC 97
;
; Reference to ^GMRPNCW is supported by DBIA 10123.
; Reference to CWAD^ORQPT2 is supported by DBIA 2831.
;
EN ; -- main entry point for PSJ LM ALLERGY DETAIL
D EN^VALM("PSJ LM ALLERGY DETAIL")
Q
;
;
INIT ; -- init variables and list array
F LINE=1:1:30 D SET^VALM10(LINE,LINE_" Line number "_LINE)
S VALMCNT=30
Q
;
HELP ; -- help code
S X="?" D DISP^XQORM1 W !!
Q
;
EXIT ; -- exit code
Q
;
EXPND ; -- expand code
Q
;
DETAIL ;
N CAUSATIV,TYPE,BLANKS S BLANKS=" " F I=1:1:16 S BLANKS=BLANKS_" "
D ^GMRADPT
I $G(GMRAL)=0 S ^TMP("PSJALLRG",$J,1,0)="PATIENT HAS NO KNOWN ALLERGIES" Q
I $G(GMRAL)="" S ^TMP("PSJALLRG",$J,1,0)="PATIENT HAS NOT BEEN ASKED ABOUT ALLERGIES" Q
N LINE,NUM,I,J,DATA S (I,J)=0
F S I=$O(GMRAL(I)) Q:I="" S DATA=$G(GMRAL(I)) Q:DATA="" S TYPE=$P(DATA,"^",3),J=J+1,PSJAL(TYPE,J)=$P(DATA,"^",2)_"^"_I,PSJAL("TOTAL")=J
S J=0 F TYPE="D","DF","DFO","DO","F","FO","O" D
.S I=0,CAPTION=$S(TYPE="D":"DRUG:",TYPE="F":"FOOD:",TYPE="DF":"DRUG/FOOD:",TYPE="DFO":"DRUG/FOOD/OTHER:",TYPE="DO":"DRUG/OTHER",TYPE="FO":"FOOD/OTHER:",1:"OTHER:"),CAPTION=CAPTION_$E(BLANKS,$L(CAPTION),17) D
..F S I=$O(PSJAL(TYPE,I)) Q:I="" D
...S J=J+1,CAUSATIV=$G(PSJAL(TYPE,I)) Q:CAUSATIV=""
...S ^TMP("PSJALLRG",$J,J,0)=" "_CAPTION_" "_J_$S($L(J)=2:" ",1:" ")_$P(CAUSATIV,"^")
...S CAPTION=" "
Q
;
VIEW ;
Q
N NUMBER,STRING,TOTAL,BLANKS,IEN S BLANKS=" " F I=1:1:49 S BLANKS=BLANKS_" "
S TOTAL=$G(PSJAL("TOTAL")) Q:'TOTAL
S DIR(0)="N^1:"_TOTAL_":0",DIR("A")="Select Allergy/ADR" D ^DIR Q:Y="^" K DIR
F TYPE="D","DF","DFO","DO","F","FO","O" S CAUSATIV=$G(PSJAL(TYPE,Y)) Q:CAUSATIV'=""
S NUMBER=$P(CAUSATIV,"^",2),J=1 D EN1^GMRAOR2(IEN,"PSJARRAY")
S STRING=" CAUSATIVE AGENT: "_$P(CAUSATIV,"^"),STRING=STRING_$E(BLANKS,$L(STRING),50)_"VA DRUG CLASS: "_$P(PSJARRAY("V",1),"^"),^TMP("PSJALLDT",$J,J,0)=STRING
K PSJARRAY
Q
CWAD(DFN) ;
I $$CWAD^ORQPT2(DFN)="" W !!,"No CWAD information for this patient." D PAUSE^VALM1 Q
W !!
NEW Y,GMRPDFN,GMRPOPT,GMRPEN,GMTSPHDR
S (Y,GMRPDFN)=DFN,GMRPOPT=1,GMRPEN=1
D ENPAT^GMRPNCW
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSJALG 2243 printed Apr 09, 2024@21:08:49 Page 2
PSJALG ;BIR/UK-DETAILED ALLERGY LIST ;15 May 98 / 9:27 AM
+1 ;;5.0; INPATIENT MEDICATIONS ;**3,85**;16 DEC 97
+2 ;
+3 ; Reference to ^GMRPNCW is supported by DBIA 10123.
+4 ; Reference to CWAD^ORQPT2 is supported by DBIA 2831.
+5 ;
EN ; -- main entry point for PSJ LM ALLERGY DETAIL
+1 DO EN^VALM("PSJ LM ALLERGY DETAIL")
+2 QUIT
+3 ;
+4 ;
INIT ; -- init variables and list array
+1 FOR LINE=1:1:30
DO SET^VALM10(LINE,LINE_" Line number "_LINE)
+2 SET VALMCNT=30
+3 QUIT
+4 ;
HELP ; -- help code
+1 SET X="?"
DO DISP^XQORM1
WRITE !!
+2 QUIT
+3 ;
EXIT ; -- exit code
+1 QUIT
+2 ;
EXPND ; -- expand code
+1 QUIT
+2 ;
DETAIL ;
+1 NEW CAUSATIV,TYPE,BLANKS
SET BLANKS=" "
FOR I=1:1:16
SET BLANKS=BLANKS_" "
+2 DO ^GMRADPT
+3 IF $GET(GMRAL)=0
SET ^TMP("PSJALLRG",$JOB,1,0)="PATIENT HAS NO KNOWN ALLERGIES"
QUIT
+4 IF $GET(GMRAL)=""
SET ^TMP("PSJALLRG",$JOB,1,0)="PATIENT HAS NOT BEEN ASKED ABOUT ALLERGIES"
QUIT
+5 NEW LINE,NUM,I,J,DATA
SET (I,J)=0
+6 FOR
SET I=$ORDER(GMRAL(I))
if I=""
QUIT
SET DATA=$GET(GMRAL(I))
if DATA=""
QUIT
SET TYPE=$PIECE(DATA,"^",3)
SET J=J+1
SET PSJAL(TYPE,J)=$PIECE(DATA,"^",2)_"^"_I
SET PSJAL("TOTAL")=J
+7 SET J=0
FOR TYPE="D","DF","DFO","DO","F","FO","O"
Begin DoDot:1
+8 SET I=0
SET CAPTION=$SELECT(TYPE="D":"DRUG:",TYPE="F":"FOOD:",TYPE="DF":"DRUG/FOOD:",TYPE="DFO":"DRUG/FOOD/OTHER:",TYPE="DO":"DRUG/OTHER",TYPE="FO":"FOOD/OTHER:",1:"OTHER:")
SET CAPTION=CAPTION_$EXTRACT(BLANKS,$LENGTH(CAPTION),17)
Begin DoDot:2
+9 FOR
SET I=$ORDER(PSJAL(TYPE,I))
if I=""
QUIT
Begin DoDot:3
+10 SET J=J+1
SET CAUSATIV=$GET(PSJAL(TYPE,I))
if CAUSATIV=""
QUIT
+11 SET ^TMP("PSJALLRG",$JOB,J,0)=" "_CAPTION_" "_J_$SELECT($LENGTH(J)=2:" ",1:" ")_$PIECE(CAUSATIV,"^")
+12 SET CAPTION=" "
End DoDot:3
End DoDot:2
End DoDot:1
+13 QUIT
+14 ;
VIEW ;
+1 QUIT
+2 NEW NUMBER,STRING,TOTAL,BLANKS,IEN
SET BLANKS=" "
FOR I=1:1:49
SET BLANKS=BLANKS_" "
+3 SET TOTAL=$GET(PSJAL("TOTAL"))
if 'TOTAL
QUIT
+4 SET DIR(0)="N^1:"_TOTAL_":0"
SET DIR("A")="Select Allergy/ADR"
DO ^DIR
if Y="^"
QUIT
KILL DIR
+5 FOR TYPE="D","DF","DFO","DO","F","FO","O"
SET CAUSATIV=$GET(PSJAL(TYPE,Y))
if CAUSATIV'=""
QUIT
+6 SET NUMBER=$PIECE(CAUSATIV,"^",2)
SET J=1
DO EN1^GMRAOR2(IEN,"PSJARRAY")
+7 SET STRING=" CAUSATIVE AGENT: "_$PIECE(CAUSATIV,"^")
SET STRING=STRING_$EXTRACT(BLANKS,$LENGTH(STRING),50)_"VA DRUG CLASS: "_$PIECE(PSJARRAY("V",1),"^")
SET ^TMP("PSJALLDT",$JOB,J,0)=STRING
+8 KILL PSJARRAY
+9 QUIT
CWAD(DFN) ;
+1 IF $$CWAD^ORQPT2(DFN)=""
WRITE !!,"No CWAD information for this patient."
DO PAUSE^VALM1
QUIT
+2 WRITE !!
+3 NEW Y,GMRPDFN,GMRPOPT,GMRPEN,GMTSPHDR
+4 SET (Y,GMRPDFN)=DFN
SET GMRPOPT=1
SET GMRPEN=1
+5 DO ENPAT^GMRPNCW
+6 QUIT
