- 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 Feb 18, 2025@23:32:33 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