PSN297P ;BIR/MR-Post install routine to fix Quinolones Drug Class issue ; 17 Jan 2012 3:18 PM
;;4.0;NATIONAL DRUG FILE;**297**; 30 Oct 98;Build 9
;Reference to UPDATE^GMRAUTL2 supported by DBIA #4667
;
S XPDIDTOT=17
N VAPRDIEN,VAGENCNT,VAGENIEN,CLASS,X,DONOTKIL,VAPRD,MSG
K ^TMP("PSNMSG",$J),^TMP("PSN297P",$J)
S ^TMP("PSNMSG",$J,1,0)="Number of Patient Allergy entries by class:"
S ^TMP("PSNMSG",$J,2,0)=" "
S ^TMP("PSNMSG",$J,3,0)="Before update:"
S ^TMP("PSNMSG",$J,4,0)="AM900 - ANTI-INFECTIVES,OTHER: "_$$CNT("AM900")
S ^TMP("PSNMSG",$J,5,0)="AM400 - QUINOLONES : "_$$CNT("AM400")
;
S (VAPRDIEN,VAGENCNT)=0
F S VAPRDIEN=$O(^PSNDF(50.68,VAPRDIEN)) Q:'VAPRDIEN D
. I +$G(^PSNDF(50.68,VAPRDIEN,3))'=640 Q
. S VAGENIEN=$P(^PSNDF(50.68,VAPRDIEN,0),"^",2)
. I $D(^TMP("PSN297P",$J,VAGENIEN)) Q
. S CLASS("D",26)=""
. S CLASS("A",640)=""
. S X=VAGENIEN_";PSNDF(50.6,^"_$P(^PSNDF(50.6,VAGENIEN,0),"^")
. S DONOTKIL=0,VAPRD=0
. F S VAPRD=$O(^PSNDF(50.6,"APRO",VAGENIEN,VAPRD)) Q:'VAPRD D
. . I $P(^PSNDF(50.68,VAPRD,3),"^")=26 S DONOTKIL=1
. I DONOTKIL K CLASS("D")
. S VAGENCNT=VAGENCNT+1
. D BMES^XPDUTL("Updating Patient Allergies for "_$P(^PSNDF(50.6,VAGENIEN,0),"^")_" ("_VAGENCNT_" of 17)...")
. I $T(UPDATE^GMRAUTL2)]"" D UPDATE^GMRAUTL2(X,,.CLASS)
. S ^TMP("PSN297P",$J,VAGENIEN)=""
. D UPDATE^XPDID(VAGENCNT)
K ^TMP("PSN297P",$J)
;
S ^TMP("PSNMSG",$J,6,0)=" "
S ^TMP("PSNMSG",$J,7,0)="After update:"
S ^TMP("PSNMSG",$J,8,0)="AM900 - ANTI-INFECTIVES,OTHER: "_$$CNT("AM900")
S ^TMP("PSNMSG",$J,9,0)="AM400 - QUINOLONES : "_$$CNT("AM400")
;
N XMY,USR,XMDUZ,XMTEXT,XMSUB,DIFROM
S XMY(DUZ)="",XMY("G.NDF DATA@"_^XMB("NETNAME"))=""
S USR=0 F S USR=$O(^XUSEC("PSNMGR",USR)) Q:'USR S XMY(USR)=""
S XMDUZ="NDF MANAGER",XMSUB="Post-install results from patch PSN*4*297"
S XMTEXT="^TMP(""PSNMSG"",$J,"
D ^XMD
Q
;
CNT(CLASS) ; Count the number of Patient Allergy entries for a specific class
N A,B,C,CNT
S (A,B,C,CNT)=0
F S A=$O(^GMR(120.8,"APC",A)) Q:'A D
. F S B=$O(^GMR(120.8,"APC",A,CLASS,B)) Q:'B D
. . F S C=$O(^GMR(120.8,"APC",A,CLASS,B,C)) Q:'C D
. . . S CNT=CNT+1
Q CNT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSN297P 2211 printed Sep 23, 2025@19:55:15 Page 2
PSN297P ;BIR/MR-Post install routine to fix Quinolones Drug Class issue ; 17 Jan 2012 3:18 PM
+1 ;;4.0;NATIONAL DRUG FILE;**297**; 30 Oct 98;Build 9
+2 ;Reference to UPDATE^GMRAUTL2 supported by DBIA #4667
+3 ;
+4 SET XPDIDTOT=17
+5 NEW VAPRDIEN,VAGENCNT,VAGENIEN,CLASS,X,DONOTKIL,VAPRD,MSG
+6 KILL ^TMP("PSNMSG",$JOB),^TMP("PSN297P",$JOB)
+7 SET ^TMP("PSNMSG",$JOB,1,0)="Number of Patient Allergy entries by class:"
+8 SET ^TMP("PSNMSG",$JOB,2,0)=" "
+9 SET ^TMP("PSNMSG",$JOB,3,0)="Before update:"
+10 SET ^TMP("PSNMSG",$JOB,4,0)="AM900 - ANTI-INFECTIVES,OTHER: "_$$CNT("AM900")
+11 SET ^TMP("PSNMSG",$JOB,5,0)="AM400 - QUINOLONES : "_$$CNT("AM400")
+12 ;
+13 SET (VAPRDIEN,VAGENCNT)=0
+14 FOR
SET VAPRDIEN=$ORDER(^PSNDF(50.68,VAPRDIEN))
if 'VAPRDIEN
QUIT
Begin DoDot:1
+15 IF +$GET(^PSNDF(50.68,VAPRDIEN,3))'=640
QUIT
+16 SET VAGENIEN=$PIECE(^PSNDF(50.68,VAPRDIEN,0),"^",2)
+17 IF $DATA(^TMP("PSN297P",$JOB,VAGENIEN))
QUIT
+18 SET CLASS("D",26)=""
+19 SET CLASS("A",640)=""
+20 SET X=VAGENIEN_";PSNDF(50.6,^"_$PIECE(^PSNDF(50.6,VAGENIEN,0),"^")
+21 SET DONOTKIL=0
SET VAPRD=0
+22 FOR
SET VAPRD=$ORDER(^PSNDF(50.6,"APRO",VAGENIEN,VAPRD))
if 'VAPRD
QUIT
Begin DoDot:2
+23 IF $PIECE(^PSNDF(50.68,VAPRD,3),"^")=26
SET DONOTKIL=1
End DoDot:2
+24 IF DONOTKIL
KILL CLASS("D")
+25 SET VAGENCNT=VAGENCNT+1
+26 DO BMES^XPDUTL("Updating Patient Allergies for "_$PIECE(^PSNDF(50.6,VAGENIEN,0),"^")_" ("_VAGENCNT_" of 17)...")
+27 IF $TEXT(UPDATE^GMRAUTL2)]""
DO UPDATE^GMRAUTL2(X,,.CLASS)
+28 SET ^TMP("PSN297P",$JOB,VAGENIEN)=""
+29 DO UPDATE^XPDID(VAGENCNT)
End DoDot:1
+30 KILL ^TMP("PSN297P",$JOB)
+31 ;
+32 SET ^TMP("PSNMSG",$JOB,6,0)=" "
+33 SET ^TMP("PSNMSG",$JOB,7,0)="After update:"
+34 SET ^TMP("PSNMSG",$JOB,8,0)="AM900 - ANTI-INFECTIVES,OTHER: "_$$CNT("AM900")
+35 SET ^TMP("PSNMSG",$JOB,9,0)="AM400 - QUINOLONES : "_$$CNT("AM400")
+36 ;
+37 NEW XMY,USR,XMDUZ,XMTEXT,XMSUB,DIFROM
+38 SET XMY(DUZ)=""
SET XMY("G.NDF DATA@"_^XMB("NETNAME"))=""
+39 SET USR=0
FOR
SET USR=$ORDER(^XUSEC("PSNMGR",USR))
if 'USR
QUIT
SET XMY(USR)=""
+40 SET XMDUZ="NDF MANAGER"
SET XMSUB="Post-install results from patch PSN*4*297"
+41 SET XMTEXT="^TMP(""PSNMSG"",$J,"
+42 DO ^XMD
+43 QUIT
+44 ;
CNT(CLASS) ; Count the number of Patient Allergy entries for a specific class
+1 NEW A,B,C,CNT
+2 SET (A,B,C,CNT)=0
+3 FOR
SET A=$ORDER(^GMR(120.8,"APC",A))
if 'A
QUIT
Begin DoDot:1
+4 FOR
SET B=$ORDER(^GMR(120.8,"APC",A,CLASS,B))
if 'B
QUIT
Begin DoDot:2
+5 FOR
SET C=$ORDER(^GMR(120.8,"APC",A,CLASS,B,C))
if 'C
QUIT
Begin DoDot:3
+6 SET CNT=CNT+1
End DoDot:3
End DoDot:2
End DoDot:1
+7 QUIT CNT
