Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PSO583PI

PSO583PI.m

Go to the documentation of this file.
  1. PSO583PI ;BIR/MFR-Post-install routine for Patch PSO*7*583 ; 02 Aug 2018 2:00 PM
  1. ;;7.0;OUTPATIENT PHARMACY;**583**;DEC 1997;Build 3
  1. ;
  1. Q
  1. POST ; entry point
  1. D BMES^XPDUTL(" Starting post-install for PSO*7*583")
  1. N ISSDT,FOUND,RXIEN,DIVNAM,PATNAM,PATIEN,STATUS,DRGIEN,DRGNAM,DOSIEN,DOSE,Z,UNITS,PSOLINE
  1. S PSOLINE=0 K ^TMP("PSO583PI",$J),^XTMP("PSO583PI",$J)
  1. D SETTXT("The CPRS patch OR*3*440 was released Back in 2017 to address a problem with")
  1. D SETTXT("the Ward Clerk Menu [OR MAIN MENU WARD CLERK] option that was causing some")
  1. D SETTXT("Outpatient Pharmacy orders and prescriptions to have the wrong dispense units.")
  1. D SETTXT("Although the problem seems to have been resolved by preventing new orders with")
  1. D SETTXT("the problem from being created it did not go far enough to prevent that")
  1. D SETTXT("existing orders with the problem could propagate the problem well into the")
  1. D SETTXT("future by being copied or renewed.")
  1. D SETTXT("The list below should be analyzed entry by entry and a determination should be")
  1. D SETTXT("made by the Pharmacy ADPAC at the site whether the outpatient prescription dose")
  1. D SETTXT("and dispense units are correct for the dispense drug or not.")
  1. D SETTXT("If it is determined that the prescription dose/dispense unit is incorrect the")
  1. D SETTXT("Outpatient Pharmacy staff should take action to discontinue the prescription")
  1. D SETTXT("and re-renter it with the correct dosing and dispense unit information.")
  1. D SETTXT("-------------------------------------------------------------------------------")
  1. D SETTXT("PATIENT (L4SSN)")
  1. D SETTXT(" RX # DISPENSE DRUG DOSE ORD. UNITS STRENGTH")
  1. D SETTXT("-------------------------------------------------------------------------------")
  1. ; Looking for Dose/Drug mismatches - Look back 1 year for Active prescriptions
  1. S ISSDT=$$FMADD^XLFDT(DT,-367),FOUND=0
  1. F S ISSDT=$O(^PSRX("AC",ISSDT)) Q:'ISSDT D
  1. . S RXIEN=0 F S RXIEN=$O(^PSRX("AC",ISSDT,RXIEN)) Q:'RXIEN D
  1. . . S DIVNAM=$$GET1^DIQ(52,RXIEN,20)
  1. . . S PATNAM=$$GET1^DIQ(52,RXIEN,2),PATIEN=$$GET1^DIQ(52,RXIEN,2,"I")
  1. . . ; Skip entry if Rx is DC'd/Expired/Deleted
  1. . . S STATUS=$$GET1^DIQ(52,RXIEN,100,"I") I STATUS>10 Q
  1. . . S DRGIEN=$$GET1^DIQ(52,RXIEN,6,"I"),DRGNAM=$$GET1^DIQ(50,DRGIEN,.01)
  1. . . ; Skip a few False positives for the logic because of Drug Composition
  1. . . I (DRGNAM["ZINC")!(DRGNAM["POTASSIUM")!(DRGNAM["CALCIUM")!(DRGNAM["FISH")!(DRGNAM["FERROUS") Q
  1. . . I (DRGNAM["PHENOBARBITAL")!(DRGNAM["LEVOTHYROXINE") Q
  1. . . ; Skip entry if Drug does not have Strength
  1. . . S STREN=$$GET1^DIQ(50,DRGIEN,901) I 'STREN Q
  1. . . ; Skip entry if Rx does not have a dose
  1. . . S DOSIEN=$O(^PSRX(RXIEN,6,0)) I 'DOSIEN Q
  1. . . ; Skip entry if Rx dose is not numeric
  1. . . S Z=$G(^PSRX(RXIEN,6,DOSIEN,0)),DOSE=+Z,UNITS=$P(Z,"^",2) I 'DOSE!'UNITS Q
  1. . . ; Skip entry if Dose = Units * Drug Strength
  1. . . I (UNITS*STREN)=DOSE Q
  1. . . ; Skip entry if discrepancy is minimal (false positive)
  1. . . I (((DOSE/STREN)<2)&((STREN/DOSE)<2)&((STREN/DOSE)'=1)) Q
  1. . . S ^TMP("PSO583PI",$J,DIVNAM_" ",PATNAM_"^"_PATIEN,RXIEN)=DOSE_"^"_UNITS_"^"_STREN
  1. . . S FOUND=FOUND+1
  1. ;
  1. I FOUND D
  1. . S (DIVNAM,PATNAM,RXIEN)=""
  1. . F S DIVNAM=$O(^TMP("PSO583PI",$J,DIVNAM)) Q:(DIVNAM="") D
  1. . . D SETTXT("Division: "_DIVNAM)
  1. . . F S PATNAM=$O(^TMP("PSO583PI",$J,DIVNAM,PATNAM)) Q:(PATNAM="") D
  1. . . . D SETPAT($P(PATNAM,"^",2))
  1. . . . F S RXIEN=$O(^TMP("PSO583PI",$J,DIVNAM,PATNAM,RXIEN)) Q:'RXIEN D
  1. . . . . S Z=^TMP("PSO583PI",$J,DIVNAM,PATNAM,RXIEN)
  1. . . . . D SETRX(RXIEN,$P(Z,"^"),$P(Z,"^",2),$P(Z,"^",3))
  1. . . D SETTXT(" ")
  1. . D SETTXT(" "),SETTXT(FOUND_" prescriptions found.")
  1. E D
  1. . D SETTXT("No prescriptions were found with a potential dose/dispense unit problem.")
  1. ;
  1. D MAIL
  1. ;
  1. D BMES^XPDUTL(" Mailman message sent.")
  1. D BMES^XPDUTL(" Finished post-install for PSO*7*583.")
  1. ;
  1. END ; Exit point
  1. K ^TMP("PSO583PI",$J),^XTMP("PSO583PI",$J)
  1. Q
  1. ;
  1. SETTXT(TXT) ; Setting Plain Text
  1. S PSOLINE=$G(PSOLINE)+1,^XTMP("PSO583PI",$J,PSOLINE)=TXT
  1. Q
  1. ;
  1. SETPAT(DFN) ; Setting Patient Line
  1. N L4SSN,VADM
  1. D DEM^VADPT S L4SSN=$P($P(VADM(2),"^",2),"-",3)
  1. S PSOLINE=$G(PSOLINE)+1,^XTMP("PSO583PI",$J,PSOLINE)=$P(VADM(1),"^")_" ("_L4SSN_")"
  1. Q
  1. ;
  1. SETRX(RXIEN,DOSE,UNITS,STREN) ; Setting Rx Line
  1. N TXTLN
  1. S $E(TXTLN,3)=$$GET1^DIQ(52,RXIEN,.01),$E(TXTLN,16)=$E($$GET1^DIQ(52,RXIEN,6),1,30)
  1. S $E(TXTLN,48)=$J(DOSE,7),$E(TXTLN,62)=$J(UNITS,4),$E(TXTLN,73)=$J(STREN,5)
  1. S PSOLINE=$G(PSOLINE)+1,^XTMP("PSO583PI",$J,PSOLINE)=TXTLN
  1. Q
  1. ;
  1. MAIL ; Sends Mailman message
  1. N II,XMX,XMSUB,XMDUZ,XMTEXT,XMY
  1. S II=0 F S II=$O(^XUSEC("PSNMGR",II)) Q:'II S XMY(II)=""
  1. S XMY(DUZ)="",XMSUB="PSO*7*583 - Renewed/Copied Rx Dose/Dispense Unit Discrepancies"
  1. S XMDUZ=.5,XMTEXT="^XTMP(""PSO583PI"",$J," N DIFROM D ^XMD
  1. Q