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

PSS224PI.m

Go to the documentation of this file.
  1. PSS224PI ;BIR/RTR - PATCH PSS*1*224 Post-Init Routine ;05/11/2018
  1. ;;1.0;PHARMACY DATA MANAGEMENT;**224**;9/30/97;Build 3
  1. ;
  1. Q
  1. ;
  1. EN ;Check for PUMP(S) in DOSE UNITS File
  1. I '$D(^PS(51.24,54)),'$$ADD D MAIL(0) Q
  1. I '$$VAL D MAIL(0) Q
  1. D MAIL(1)
  1. Q
  1. ;
  1. ;
  1. VAL() ;Validate data
  1. D BMES^XPDUTL("Validating PUMP(S) entry in DOSE UNITS (#51.24) File...")
  1. I $G(^PS(51.24,54,0))'="PUMP(S)^PUMPS^1" Q 0
  1. I $G(^PS(51.24,54,1,1,0))'="PUMP" Q 0
  1. I '$D(^PS(51.24,54,1,"B","PUMP",1)) Q 0
  1. I '$D(^PS(51.24,"B","PUMP(S)",54)) Q 0
  1. I '$D(^PS(51.24,"C","PUMPS",54)) Q 0
  1. I '$D(^PS(51.24,"D","PUMP",54,1)) Q 0
  1. I '$D(^PS(51.24,"UPCASE","PUMP(S)",54)) Q 0
  1. Q 1
  1. ;
  1. ;
  1. MAIL(PSSPUMRS) ;send mail message
  1. ;PSSPUMRS=0 - Problem adding PUMP(S)
  1. ;PSSPUMRS=1 - PUMP(S) added successfully
  1. N XMTEXT,XMY,XMSUB,XMDUZ,XMMG,XMSTRIP,XMROU,XMYBLOB,XMZ
  1. K ^TMP($J,"PSS224TX")
  1. S ^TMP($J,"PSS224TX",1)="PSS*1.0*224 patch installation has completed.",^TMP($J,"PSS224TX",2)=""
  1. I 'PSSPUMRS D
  1. .D BMES^XPDUTL("***Invalid PUMP(S) entry in your DOSE UNITS (#51.24) File...")
  1. .S ^TMP($J,"PSS224TX",3)="A problem was encountered when adding/verifying the new PUMP(S) entry in"
  1. .S ^TMP($J,"PSS224TX",4)="your DOSE UNITS (#51.24) File. It is OK to install the remaining Mocha 2.1b"
  1. .S ^TMP($J,"PSS224TX",5)="warranty patches, but contact the national help desk for assistance with this"
  1. .S ^TMP($J,"PSS224TX",6)="Dose Unit problem. Refer to the PSS*1.0*224 patch installation in the ticket."
  1. I PSSPUMRS D
  1. .D BMES^XPDUTL("PUMP(S) successfully added to DOSE UNITS (#51.24) File...")
  1. .S ^TMP($J,"PSS224TX",3)="The new Dose Unit of PUMP(S) was successfully added to your DOSE"
  1. .S ^TMP($J,"PSS224TX",4)="UNITS (#51.24) File, no further action is necessary."
  1. S XMSUB="PSS*1.0*224 Installation Complete"
  1. S XMDUZ="PSS*1.0*224 Install"
  1. S XMTEXT="^TMP($J,""PSS224TX"","
  1. S XMY("G.PSS ORDER CHECKS")=""
  1. I $G(DUZ) S XMY(DUZ)=""
  1. N DIFROM D ^XMD
  1. I $D(XMMG) D
  1. .D BMES^XPDUTL("Problem sending mail message upon PSS*1*224 installation completion...")
  1. .I 'PSSPUMRS D Q
  1. ..D BMES^XPDUTL("***Invalid PUMP(S) entry in your DOSE UNITS (#51.24) File...")
  1. .D BMES^XPDUTL("PUMP(S) successfully added to DOSE UNITS (#51.24) File...")
  1. K ^TMP($J,"PSS224TX")
  1. Q
  1. ;
  1. ;
  1. ADD() ;Add PUMP(S) to Dose Units File
  1. ;Quit with 0 if unable to add
  1. D BMES^XPDUTL("Adding PUMP(S) to DOSE UNITS (#51.24) File...")
  1. N PSSADPMP,PSSADIEN,XUMF
  1. D KTMP S XUMF=""
  1. S PSSADPMP(1,51.24,"+1,",.01)="PUMP(S)"
  1. S PSSADPMP(1,51.24,"+1,",1)="PUMPS"
  1. S PSSADPMP(1,51.24,"+1,",3)=1
  1. S PSSADIEN(1)=54
  1. D UPDATE^DIE("","PSSADPMP(1)","PSSADIEN") I $D(^TMP("DIERR",$J)) D KTMP Q 0
  1. K PSSADPMP,PSSADIEN
  1. I $P($G(^PS(51.24,54,0)),"^")'="PUMP(S)" Q 0
  1. S PSSADIEN=54,XUMF=""
  1. S PSSADPMP(1,51.242,"+2,"_PSSADIEN_",",.01)="PUMP"
  1. D UPDATE^DIE("","PSSADPMP(1)")
  1. I $D(^TMP("DIERR",$J)) D KTMP Q 0
  1. D KTMP K XUMF
  1. Q 1
  1. ;
  1. ;
  1. KTMP ;Kill TMP error global
  1. K ^TMP("DIERR",$J)
  1. Q