GMRAPS49 ;BPOIFO/HW - Patient Allergies with comments containing carriage returns; 5/05/16 3:42pm
;;4.0;Adverse Reaction Tracking;**49**;Mar 29, 1996;Build 2
;
; This routine uses the following IAs:
; #10061 - DEM^VADPT (supported)
; #10070 - ^XMD (supported)
; #4440 - PROD^XUPROD (supported)
; #10112 - SITE^VASITE (supported)
Q ;Must be called at entry point
EN N GMRAIEN,DFN,GMRTOTAL,DIFROM
K ^TMP("GMRA",$J)
S GMRAIEN=0,GMRTOTAL=0
D BMES^XPDUTL(" PATIENT ALLERGY RECORDS WITH CARRIAGE RETURNS IN COMMENTS")
D MES^XPDUTL(" (CARRIAGE RETURNS REMOVED BY THIS PATCH)")
D BMES^XPDUTL(" ")
D BMES^XPDUTL("DFN Patient Allergy IEN Reactant ")
D MES^XPDUTL(" ")
S ^TMP("GMRA",$J,1)=" ****ATTENTION Pharmacy Manager or ADPAC****"
S ^TMP("GMRA",$J,2)=" "
S ^TMP("GMRA",$J,3)="Please review the records in this report/mail message and edit these patient "
S ^TMP("GMRA",$J,4)="allergy records to trigger a new HL7 message to HDR. Use the GMRA PATIENT "
S ^TMP("GMRA",$J,5)="A/AR EDIT [Enter/Edit Patient Reaction Data] option to select the affected "
S ^TMP("GMRA",$J,6)="records. You will need the GMRA-ALLERGY VERIFY key to complete this action:"
S ^TMP("GMRA",$J,7)=" "
S ^TMP("GMRA",$J,8)=" Select PATIENT NAME:`(enter the grave accent followed by a DFN from report"
S ^TMP("GMRA",$J,9)=" below)"
S ^TMP("GMRA",$J,10)=" (List of reactants displays here)"
S ^TMP("GMRA",$J,11)=" Enter Causative Agent: (enter corresponding Reactant from report below)"
S ^TMP("GMRA",$J,12)=" (Allergy Information displays here)"
S ^TMP("GMRA",$J,13)=" Is the reaction information correct? Yes// (Yes)"
S ^TMP("GMRA",$J,14)=" DO YOU WISH TO EDIT VERIFIED DATA? NO// YES"
S ^TMP("GMRA",$J,15)=" (Allergy Data displays here)"
S ^TMP("GMRA",$J,16)=" Would you like to edit any of this data? YES"
S ^TMP("GMRA",$J,17)=" "
S ^TMP("GMRA",$J,18)="Then accept all existing values. When asked again ""Would you like to edit any"
S ^TMP("GMRA",$J,19)="of this data?"" respond ""NO"" to end the correction process. This will update"
S ^TMP("GMRA",$J,20)="the data in HDR. When completed please notify Pharmacy Benefits Management"
S ^TMP("GMRA",$J,21)="Services by replying to this message (send to Silverman.Robert@DOMAIN.EXT)."
S ^TMP("GMRA",$J,22)="Please include your site information in the message. "
S ^TMP("GMRA",$J,23)=" "
S ^TMP("GMRA",$J,24)=" PATIENT ALLERGY RECORDS WITH CARRIAGE RETURNS IN COMMENTS"
S ^TMP("GMRA",$J,25)=" (CARRIAGE RETURNS REMOVED BY PATCH GMRA*4.0*49) "
S ^TMP("GMRA",$J,26)=" "
S ^TMP("GMRA",$J,27)="DFN"_" Patient Allergy IEN"_" Reactant "
D FIND(.GMRTOTAL)
S GMRASITE=$$SITE^VASITE
S GMRASTNM=$P($G(GMRASITE),"^",2)
S GMRASTN=$P($G(GMRASITE),"^",3)
I GMRTOTAL'<1 D
.S GMRAGLNR=GMRTOTAL+31
.S ^TMP("GMRA",$J,GMRAGLNR)=" "
.S ^TMP("GMRA",$J,GMRAGLNR+1)=" "
.S ^TMP("GMRA",$J,GMRAGLNR+2)=" "
.S ^TMP("GMRA",$J,GMRAGLNR+3)="Site Name: "_GMRASTNM
.S ^TMP("GMRA",$J,GMRAGLNR+4)="Station: "_GMRASTN
I GMRTOTAL<1 D
.D BMES^XPDUTL(" No records with carriage returns found. NO FURTHER ACTION IS NEEDED.")
.D BMES^XPDUTL(" ")
.S ^TMP("GMRA",$J,28)=" "
.S ^TMP("GMRA",$J,29)=" No records with carriage returns found. NO FURTHER ACTION IS NEEDED."
.S ^TMP("GMRA",$J,30)=" "
.S ^TMP("GMRA",$J,31)=" "
.S ^TMP("GMRA",$J,32)="Site Name: "_GMRASTNM
.S ^TMP("GMRA",$J,33)="Station: "_GMRASTN
S XMSUB="ACTION REQUIRED GMRA*4*49 Post-Install Results"
I GMRTOTAL<1 S XMSUB="GMRA*4*49 Post-Install Results"
S XMTEXT="^TMP(""GMRA"",$J,",XMY(DUZ)=""
I $$PROD^XUPROD S XMY("Silverman.Robert@DOMAIN.EXT")="" ;only send to PBM from prod
S XMY("Wolf.Honorata@DOMAIN.EXT")=""
S USR=0 F S USR=$O(^XUSEC("GMRA-ALLERGY VERIFY",USR)) Q:'USR S XMY(USR)=""
S XMDUZ="GMRA*4.0*49 POST INSTALL"
D BMES^XPDUTL(" ")
D BMES^XPDUTL(" ")
D BMES^XPDUTL(" ")
D MES^XPDUTL("A copy of this report (with instructions) has been sent to the appropriate recipients")
D ^XMD K XMSUB,XMTEXT,XMY,USR,XMDUZ,GMRAGLNR,GMRASITE,GMRASTN,GMRASTNM
Q
FIND(GMRTOTAL) ;Check 120.8 for carriage returns in comments
N GMRAX,DFN,VADM,VA,GMRASP1,GMRASPN1,GMRASP2,GMRASPN2,GMRAREAC
N GMRAIEN,GMRSEC,GMRTHIRD,DFN
S GMRAIEN=0,GMRTOTAL=0
F S GMRAIEN=$O(^GMR(120.8,GMRAIEN)) Q:GMRAIEN'>0 D
.;Exclude if patient has Date of Death
.S DFN=$P($G(^GMR(120.8,GMRAIEN,0)),"^",1)
.I DFN>0 D
..D DEM^VADPT
..I $G(VADM(6))>0 Q
.;Check Comments field
.S GMRSEC=0
.F S GMRSEC=$O(^GMR(120.8,GMRAIEN,26,GMRSEC)) Q:GMRSEC'>0 D
..S GMRTHIRD=0
..F S GMRTHIRD=$O(^GMR(120.8,GMRAIEN,26,GMRSEC,2,GMRTHIRD)) Q:GMRTHIRD'>0 D
...I ^GMR(120.8,GMRAIEN,26,GMRSEC,2,GMRTHIRD,0)'[$C(13) Q
...S ^GMR(120.8,GMRAIEN,26,GMRSEC,2,GMRTHIRD,0)=$TR(^GMR(120.8,GMRAIEN,26,GMRSEC,2,GMRTHIRD,0),$C(13)," ") ;Replace <CR> with space
...S ^GMR(120.8,GMRAIEN,26,GMRSEC,2,GMRTHIRD,0)=$TR(^GMR(120.8,GMRAIEN,26,GMRSEC,2,GMRTHIRD,0),$C(10)," ") ;Replace <LF> with space
...S GMRTOTAL=GMRTOTAL+1
...S GMRAREAC=$P($G(^GMR(120.8,GMRAIEN,0)),"^",2)
...S GMRASP1="",GMRASP2=""
...S GMRASPN1=12-$L(DFN) F GMRAX=1:1:GMRASPN1 S GMRASP1=GMRASP1_" "
...S GMRASPN2=34-$L(GMRAIEN)-$L(DFN)-$L(GMRASP1) F GMRAX=1:1:GMRASPN2 S GMRASP2=GMRASP2_" "
...S ^TMP("GMRA",$J,GMRTOTAL+28)=DFN_GMRASP1_GMRAIEN_GMRASP2_GMRAREAC
...D MES^XPDUTL(DFN_GMRASP1_GMRAIEN_GMRASP2_GMRAREAC)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRAPS49 6117 printed Sep 23, 2025@19:16:14 Page 2
GMRAPS49 ;BPOIFO/HW - Patient Allergies with comments containing carriage returns; 5/05/16 3:42pm
+1 ;;4.0;Adverse Reaction Tracking;**49**;Mar 29, 1996;Build 2
+2 ;
+3 ; This routine uses the following IAs:
+4 ; #10061 - DEM^VADPT (supported)
+5 ; #10070 - ^XMD (supported)
+6 ; #4440 - PROD^XUPROD (supported)
+7 ; #10112 - SITE^VASITE (supported)
+8 ;Must be called at entry point
QUIT
EN NEW GMRAIEN,DFN,GMRTOTAL,DIFROM
+1 KILL ^TMP("GMRA",$JOB)
+2 SET GMRAIEN=0
SET GMRTOTAL=0
+3 DO BMES^XPDUTL(" PATIENT ALLERGY RECORDS WITH CARRIAGE RETURNS IN COMMENTS")
+4 DO MES^XPDUTL(" (CARRIAGE RETURNS REMOVED BY THIS PATCH)")
+5 DO BMES^XPDUTL(" ")
+6 DO BMES^XPDUTL("DFN Patient Allergy IEN Reactant ")
+7 DO MES^XPDUTL(" ")
+8 SET ^TMP("GMRA",$JOB,1)=" ****ATTENTION Pharmacy Manager or ADPAC****"
+9 SET ^TMP("GMRA",$JOB,2)=" "
+10 SET ^TMP("GMRA",$JOB,3)="Please review the records in this report/mail message and edit these patient "
+11 SET ^TMP("GMRA",$JOB,4)="allergy records to trigger a new HL7 message to HDR. Use the GMRA PATIENT "
+12 SET ^TMP("GMRA",$JOB,5)="A/AR EDIT [Enter/Edit Patient Reaction Data] option to select the affected "
+13 SET ^TMP("GMRA",$JOB,6)="records. You will need the GMRA-ALLERGY VERIFY key to complete this action:"
+14 SET ^TMP("GMRA",$JOB,7)=" "
+15 SET ^TMP("GMRA",$JOB,8)=" Select PATIENT NAME:`(enter the grave accent followed by a DFN from report"
+16 SET ^TMP("GMRA",$JOB,9)=" below)"
+17 SET ^TMP("GMRA",$JOB,10)=" (List of reactants displays here)"
+18 SET ^TMP("GMRA",$JOB,11)=" Enter Causative Agent: (enter corresponding Reactant from report below)"
+19 SET ^TMP("GMRA",$JOB,12)=" (Allergy Information displays here)"
+20 SET ^TMP("GMRA",$JOB,13)=" Is the reaction information correct? Yes// (Yes)"
+21 SET ^TMP("GMRA",$JOB,14)=" DO YOU WISH TO EDIT VERIFIED DATA? NO// YES"
+22 SET ^TMP("GMRA",$JOB,15)=" (Allergy Data displays here)"
+23 SET ^TMP("GMRA",$JOB,16)=" Would you like to edit any of this data? YES"
+24 SET ^TMP("GMRA",$JOB,17)=" "
+25 SET ^TMP("GMRA",$JOB,18)="Then accept all existing values. When asked again ""Would you like to edit any"
+26 SET ^TMP("GMRA",$JOB,19)="of this data?"" respond ""NO"" to end the correction process. This will update"
+27 SET ^TMP("GMRA",$JOB,20)="the data in HDR. When completed please notify Pharmacy Benefits Management"
+28 SET ^TMP("GMRA",$JOB,21)="Services by replying to this message (send to Silverman.Robert@DOMAIN.EXT)."
+29 SET ^TMP("GMRA",$JOB,22)="Please include your site information in the message. "
+30 SET ^TMP("GMRA",$JOB,23)=" "
+31 SET ^TMP("GMRA",$JOB,24)=" PATIENT ALLERGY RECORDS WITH CARRIAGE RETURNS IN COMMENTS"
+32 SET ^TMP("GMRA",$JOB,25)=" (CARRIAGE RETURNS REMOVED BY PATCH GMRA*4.0*49) "
+33 SET ^TMP("GMRA",$JOB,26)=" "
+34 SET ^TMP("GMRA",$JOB,27)="DFN"_" Patient Allergy IEN"_" Reactant "
+35 DO FIND(.GMRTOTAL)
+36 SET GMRASITE=$$SITE^VASITE
+37 SET GMRASTNM=$PIECE($GET(GMRASITE),"^",2)
+38 SET GMRASTN=$PIECE($GET(GMRASITE),"^",3)
+39 IF GMRTOTAL'<1
Begin DoDot:1
+40 SET GMRAGLNR=GMRTOTAL+31
+41 SET ^TMP("GMRA",$JOB,GMRAGLNR)=" "
+42 SET ^TMP("GMRA",$JOB,GMRAGLNR+1)=" "
+43 SET ^TMP("GMRA",$JOB,GMRAGLNR+2)=" "
+44 SET ^TMP("GMRA",$JOB,GMRAGLNR+3)="Site Name: "_GMRASTNM
+45 SET ^TMP("GMRA",$JOB,GMRAGLNR+4)="Station: "_GMRASTN
End DoDot:1
+46 IF GMRTOTAL<1
Begin DoDot:1
+47 DO BMES^XPDUTL(" No records with carriage returns found. NO FURTHER ACTION IS NEEDED.")
+48 DO BMES^XPDUTL(" ")
+49 SET ^TMP("GMRA",$JOB,28)=" "
+50 SET ^TMP("GMRA",$JOB,29)=" No records with carriage returns found. NO FURTHER ACTION IS NEEDED."
+51 SET ^TMP("GMRA",$JOB,30)=" "
+52 SET ^TMP("GMRA",$JOB,31)=" "
+53 SET ^TMP("GMRA",$JOB,32)="Site Name: "_GMRASTNM
+54 SET ^TMP("GMRA",$JOB,33)="Station: "_GMRASTN
End DoDot:1
+55 SET XMSUB="ACTION REQUIRED GMRA*4*49 Post-Install Results"
+56 IF GMRTOTAL<1
SET XMSUB="GMRA*4*49 Post-Install Results"
+57 SET XMTEXT="^TMP(""GMRA"",$J,"
SET XMY(DUZ)=""
+58 ;only send to PBM from prod
IF $$PROD^XUPROD
SET XMY("Silverman.Robert@DOMAIN.EXT")=""
+59 SET XMY("Wolf.Honorata@DOMAIN.EXT")=""
+60 SET USR=0
FOR
SET USR=$ORDER(^XUSEC("GMRA-ALLERGY VERIFY",USR))
if 'USR
QUIT
SET XMY(USR)=""
+61 SET XMDUZ="GMRA*4.0*49 POST INSTALL"
+62 DO BMES^XPDUTL(" ")
+63 DO BMES^XPDUTL(" ")
+64 DO BMES^XPDUTL(" ")
+65 DO MES^XPDUTL("A copy of this report (with instructions) has been sent to the appropriate recipients")
+66 DO ^XMD
KILL XMSUB,XMTEXT,XMY,USR,XMDUZ,GMRAGLNR,GMRASITE,GMRASTN,GMRASTNM
+67 QUIT
FIND(GMRTOTAL) ;Check 120.8 for carriage returns in comments
+1 NEW GMRAX,DFN,VADM,VA,GMRASP1,GMRASPN1,GMRASP2,GMRASPN2,GMRAREAC
+2 NEW GMRAIEN,GMRSEC,GMRTHIRD,DFN
+3 SET GMRAIEN=0
SET GMRTOTAL=0
+4 FOR
SET GMRAIEN=$ORDER(^GMR(120.8,GMRAIEN))
if GMRAIEN'>0
QUIT
Begin DoDot:1
+5 ;Exclude if patient has Date of Death
+6 SET DFN=$PIECE($GET(^GMR(120.8,GMRAIEN,0)),"^",1)
+7 IF DFN>0
Begin DoDot:2
+8 DO DEM^VADPT
+9 IF $GET(VADM(6))>0
QUIT
End DoDot:2
+10 ;Check Comments field
+11 SET GMRSEC=0
+12 FOR
SET GMRSEC=$ORDER(^GMR(120.8,GMRAIEN,26,GMRSEC))
if GMRSEC'>0
QUIT
Begin DoDot:2
+13 SET GMRTHIRD=0
+14 FOR
SET GMRTHIRD=$ORDER(^GMR(120.8,GMRAIEN,26,GMRSEC,2,GMRTHIRD))
if GMRTHIRD'>0
QUIT
Begin DoDot:3
+15 IF ^GMR(120.8,GMRAIEN,26,GMRSEC,2,GMRTHIRD,0)'[$CHAR(13)
QUIT
+16 ;Replace <CR> with space
SET ^GMR(120.8,GMRAIEN,26,GMRSEC,2,GMRTHIRD,0)=$TRANSLATE(^GMR(120.8,GMRAIEN,26,GMRSEC,2,GMRTHIRD,0),$CHAR(13)," ")
+17 ;Replace <LF> with space
SET ^GMR(120.8,GMRAIEN,26,GMRSEC,2,GMRTHIRD,0)=$TRANSLATE(^GMR(120.8,GMRAIEN,26,GMRSEC,2,GMRTHIRD,0),$CHAR(10)," ")
+18 SET GMRTOTAL=GMRTOTAL+1
+19 SET GMRAREAC=$PIECE($GET(^GMR(120.8,GMRAIEN,0)),"^",2)
+20 SET GMRASP1=""
SET GMRASP2=""
+21 SET GMRASPN1=12-$LENGTH(DFN)
FOR GMRAX=1:1:GMRASPN1
SET GMRASP1=GMRASP1_" "
+22 SET GMRASPN2=34-$LENGTH(GMRAIEN)-$LENGTH(DFN)-$LENGTH(GMRASP1)
FOR GMRAX=1:1:GMRASPN2
SET GMRASP2=GMRASP2_" "
+23 SET ^TMP("GMRA",$JOB,GMRTOTAL+28)=DFN_GMRASP1_GMRAIEN_GMRASP2_GMRAREAC
+24 DO MES^XPDUTL(DFN_GMRASP1_GMRAIEN_GMRASP2_GMRAREAC)
End DoDot:3
End DoDot:2
End DoDot:1
+25 QUIT
