PSN471P ;BIR/HW-Post install routine to update Trade Name allergies - Class; 29 January 2016 3:18 PM
;;4.0;NATIONAL DRUG FILE;**471**; 30 Oct 98;Build 17
;Reference to UPDATE^GMRAUTL2 supported by DBIA #4667
;This routine will update patient allergies with a Trade Name in the Reactant field
;based on the VA Generic and VA Drug Class(es) provided
Q
EN ;Call at entry point
N PSNPRIEN,PSNTNCNT,PSNGIEN,PSNCLASS,PSNX,PSNDONTK,PSNVAPRD,MSG,PSNTRNAM,PSNDCIEN,XPDIDTOT
S XPDIDTOT=3
K ^TMP("PSNMSG",$J),^TMP("PSN471P",$J)
S ^TMP("PSNMSG",$J,1,0)="Number of Patient Allergy entries by VA DRUG CLASS:"
S ^TMP("PSNMSG",$J,2,0)=" "
S ^TMP("PSNMSG",$J,3,0)="Before update:"
S ^TMP("PSNMSG",$J,4,0)="HS900 - HORMONES/SYNTHETICS/MODIFIERS,OTHER: "_$$CNT("HS900")
S ^TMP("PSNMSG",$J,5,0)="CV150 - ALPHA BLOCKERS/RELATED: "_$$CNT("CV150")
S ^TMP("PSNMSG",$J,6,0)=" "
S PSNTNCNT=0
S PSNVAGEN=3889,PSNOCL=138,PSNNCL=297 D UPDATE(PSNVAGEN,PSNOCL,PSNNCL,.PSNTNCNT) ;ALFUZOSIN (138 is HS900, 297 is CV150)
;
K ^TMP("PSN471P",$J)
;
S ^TMP("PSNMSG",$J,9,0)=" "
S ^TMP("PSNMSG",$J,10,0)=" "
S ^TMP("PSNMSG",$J,11,0)="After update:"
S ^TMP("PSNMSG",$J,12,0)="HS900 - HORMONES/SYNTHETICS/MODIFIERS,OTHER: "_$$CNT("HS900")
S ^TMP("PSNMSG",$J,13,0)="CV150 - ALPHA BLOCKERS/RELATED: "_$$CNT("CV150")
S ^TMP("PSNMSG",$J,14,0)=" "
;
K PSNVAGEN,PSNOCL,PSNNCL
Q
;
CNT(PSNCLASS) ;Count the number of Patient Allergy entries for a specific class
N PSNA,PSNB,PSNC,PSNCNT
S (PSNA,PSNB,PSNC,PSNCNT)=0
F S PSNA=$O(^GMR(120.8,"APC",PSNA)) Q:'PSNA D
.F S PSNB=$O(^GMR(120.8,"APC",PSNA,PSNCLASS,PSNB)) Q:'PSNB D
..F S PSNC=$O(^GMR(120.8,"APC",PSNA,PSNCLASS,PSNB,PSNC)) Q:'PSNC D
...S PSNCNT=PSNCNT+1
Q PSNCNT
UPDATE(PSNVAGEN,PSNOCL,PSNNCL,PSNTNCNT) ;Find Trade Names and update Allergies
N PSNCLA
S PSNCLA("D",PSNOCL)="" ;IEN of class to be deleted
S PSNCLA("A",PSNNCL)="" ;IEN of class to be added
S PSNPRIEN=0
F S PSNPRIEN=$O(^PSNDF(50.68,PSNPRIEN)) Q:'PSNPRIEN D
.I +$P($G(^PSNDF(50.68,PSNPRIEN,0)),"^",2)'=PSNVAGEN Q
.I +$G(^PSNDF(50.68,PSNPRIEN,3))'=PSNNCL Q
.S PSNGIEN=$P(^PSNDF(50.68,PSNPRIEN,0),"^",2)
.S PSNDCIEN=0
.F S PSNDCIEN=$O(^PSNDF(50.68,"ANDC",PSNPRIEN,PSNDCIEN)) Q:'PSNDCIEN D
..S PSNTRNAM=$P($G(^PSNDF(50.67,PSNDCIEN,0)),"^",5)
..I $D(^TMP("PSN471P",$J,PSNGIEN,PSNTRNAM)) Q
..S PSNX=PSNGIEN_";PSNDF(50.6,^"_PSNTRNAM
..S PSNDONTK=0,PSNVAPRD=0
..F S PSNVAPRD=$O(^PSNDF(50.6,"APRO",PSNGIEN,PSNVAPRD)) Q:'PSNVAPRD D
...I $P(^PSNDF(50.68,PSNVAPRD,3),"^")=PSNOCL S PSNDONTK=1
..I PSNDONTK K PSNCLA("D")
..S PSNTNCNT=PSNTNCNT+1
..D BMES^XPDUTL("Updating Patient Allergies for "_PSNTRNAM)
..I $T(UPDATE^GMRAUTL2)]"" D UPDATE^GMRAUTL2(PSNX,,.PSNCLA)
..S ^TMP("PSN471P",$J,PSNGIEN,PSNTRNAM)=""
..D UPDATE^XPDID(PSNTNCNT)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSN471P 2902 printed Sep 23, 2025@19:57:49 Page 2
PSN471P ;BIR/HW-Post install routine to update Trade Name allergies - Class; 29 January 2016 3:18 PM
+1 ;;4.0;NATIONAL DRUG FILE;**471**; 30 Oct 98;Build 17
+2 ;Reference to UPDATE^GMRAUTL2 supported by DBIA #4667
+3 ;This routine will update patient allergies with a Trade Name in the Reactant field
+4 ;based on the VA Generic and VA Drug Class(es) provided
+5 QUIT
EN ;Call at entry point
+1 NEW PSNPRIEN,PSNTNCNT,PSNGIEN,PSNCLASS,PSNX,PSNDONTK,PSNVAPRD,MSG,PSNTRNAM,PSNDCIEN,XPDIDTOT
+2 SET XPDIDTOT=3
+3 KILL ^TMP("PSNMSG",$JOB),^TMP("PSN471P",$JOB)
+4 SET ^TMP("PSNMSG",$JOB,1,0)="Number of Patient Allergy entries by VA DRUG CLASS:"
+5 SET ^TMP("PSNMSG",$JOB,2,0)=" "
+6 SET ^TMP("PSNMSG",$JOB,3,0)="Before update:"
+7 SET ^TMP("PSNMSG",$JOB,4,0)="HS900 - HORMONES/SYNTHETICS/MODIFIERS,OTHER: "_$$CNT("HS900")
+8 SET ^TMP("PSNMSG",$JOB,5,0)="CV150 - ALPHA BLOCKERS/RELATED: "_$$CNT("CV150")
+9 SET ^TMP("PSNMSG",$JOB,6,0)=" "
+10 SET PSNTNCNT=0
+11 ;ALFUZOSIN (138 is HS900, 297 is CV150)
SET PSNVAGEN=3889
SET PSNOCL=138
SET PSNNCL=297
DO UPDATE(PSNVAGEN,PSNOCL,PSNNCL,.PSNTNCNT)
+12 ;
+13 KILL ^TMP("PSN471P",$JOB)
+14 ;
+15 SET ^TMP("PSNMSG",$JOB,9,0)=" "
+16 SET ^TMP("PSNMSG",$JOB,10,0)=" "
+17 SET ^TMP("PSNMSG",$JOB,11,0)="After update:"
+18 SET ^TMP("PSNMSG",$JOB,12,0)="HS900 - HORMONES/SYNTHETICS/MODIFIERS,OTHER: "_$$CNT("HS900")
+19 SET ^TMP("PSNMSG",$JOB,13,0)="CV150 - ALPHA BLOCKERS/RELATED: "_$$CNT("CV150")
+20 SET ^TMP("PSNMSG",$JOB,14,0)=" "
+21 ;
+22 KILL PSNVAGEN,PSNOCL,PSNNCL
+23 QUIT
+24 ;
CNT(PSNCLASS) ;Count the number of Patient Allergy entries for a specific class
+1 NEW PSNA,PSNB,PSNC,PSNCNT
+2 SET (PSNA,PSNB,PSNC,PSNCNT)=0
+3 FOR
SET PSNA=$ORDER(^GMR(120.8,"APC",PSNA))
if 'PSNA
QUIT
Begin DoDot:1
+4 FOR
SET PSNB=$ORDER(^GMR(120.8,"APC",PSNA,PSNCLASS,PSNB))
if 'PSNB
QUIT
Begin DoDot:2
+5 FOR
SET PSNC=$ORDER(^GMR(120.8,"APC",PSNA,PSNCLASS,PSNB,PSNC))
if 'PSNC
QUIT
Begin DoDot:3
+6 SET PSNCNT=PSNCNT+1
End DoDot:3
End DoDot:2
End DoDot:1
+7 QUIT PSNCNT
UPDATE(PSNVAGEN,PSNOCL,PSNNCL,PSNTNCNT) ;Find Trade Names and update Allergies
+1 NEW PSNCLA
+2 ;IEN of class to be deleted
SET PSNCLA("D",PSNOCL)=""
+3 ;IEN of class to be added
SET PSNCLA("A",PSNNCL)=""
+4 SET PSNPRIEN=0
+5 FOR
SET PSNPRIEN=$ORDER(^PSNDF(50.68,PSNPRIEN))
if 'PSNPRIEN
QUIT
Begin DoDot:1
+6 IF +$PIECE($GET(^PSNDF(50.68,PSNPRIEN,0)),"^",2)'=PSNVAGEN
QUIT
+7 IF +$GET(^PSNDF(50.68,PSNPRIEN,3))'=PSNNCL
QUIT
+8 SET PSNGIEN=$PIECE(^PSNDF(50.68,PSNPRIEN,0),"^",2)
+9 SET PSNDCIEN=0
+10 FOR
SET PSNDCIEN=$ORDER(^PSNDF(50.68,"ANDC",PSNPRIEN,PSNDCIEN))
if 'PSNDCIEN
QUIT
Begin DoDot:2
+11 SET PSNTRNAM=$PIECE($GET(^PSNDF(50.67,PSNDCIEN,0)),"^",5)
+12 IF $DATA(^TMP("PSN471P",$JOB,PSNGIEN,PSNTRNAM))
QUIT
+13 SET PSNX=PSNGIEN_";PSNDF(50.6,^"_PSNTRNAM
+14 SET PSNDONTK=0
SET PSNVAPRD=0
+15 FOR
SET PSNVAPRD=$ORDER(^PSNDF(50.6,"APRO",PSNGIEN,PSNVAPRD))
if 'PSNVAPRD
QUIT
Begin DoDot:3
+16 IF $PIECE(^PSNDF(50.68,PSNVAPRD,3),"^")=PSNOCL
SET PSNDONTK=1
End DoDot:3
+17 IF PSNDONTK
KILL PSNCLA("D")
+18 SET PSNTNCNT=PSNTNCNT+1
+19 DO BMES^XPDUTL("Updating Patient Allergies for "_PSNTRNAM)
+20 IF $TEXT(UPDATE^GMRAUTL2)]""
DO UPDATE^GMRAUTL2(PSNX,,.PSNCLA)
+21 SET ^TMP("PSN471P",$JOB,PSNGIEN,PSNTRNAM)=""
+22 DO UPDATE^XPDID(PSNTNCNT)
End DoDot:2
End DoDot:1
+23 QUIT
