GMRAPS49.m

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 ---GMRAPS49   6117     printed  Apr 09, 2024@20:44:46                                                                                                                                                                                                    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