PSS224PI ;BIR/RTR - PATCH PSS*1*224 Post-Init Routine ;05/11/2018
;;1.0;PHARMACY DATA MANAGEMENT;**224**;9/30/97;Build 3
;
Q
;
EN ;Check for PUMP(S) in DOSE UNITS File
I '$D(^PS(51.24,54)),'$$ADD D MAIL(0) Q
I '$$VAL D MAIL(0) Q
D MAIL(1)
Q
;
;
VAL() ;Validate data
D BMES^XPDUTL("Validating PUMP(S) entry in DOSE UNITS (#51.24) File...")
I $G(^PS(51.24,54,0))'="PUMP(S)^PUMPS^1" Q 0
I $G(^PS(51.24,54,1,1,0))'="PUMP" Q 0
I '$D(^PS(51.24,54,1,"B","PUMP",1)) Q 0
I '$D(^PS(51.24,"B","PUMP(S)",54)) Q 0
I '$D(^PS(51.24,"C","PUMPS",54)) Q 0
I '$D(^PS(51.24,"D","PUMP",54,1)) Q 0
I '$D(^PS(51.24,"UPCASE","PUMP(S)",54)) Q 0
Q 1
;
;
MAIL(PSSPUMRS) ;send mail message
;PSSPUMRS=0 - Problem adding PUMP(S)
;PSSPUMRS=1 - PUMP(S) added successfully
N XMTEXT,XMY,XMSUB,XMDUZ,XMMG,XMSTRIP,XMROU,XMYBLOB,XMZ
K ^TMP($J,"PSS224TX")
S ^TMP($J,"PSS224TX",1)="PSS*1.0*224 patch installation has completed.",^TMP($J,"PSS224TX",2)=""
I 'PSSPUMRS D
.D BMES^XPDUTL("***Invalid PUMP(S) entry in your DOSE UNITS (#51.24) File...")
.S ^TMP($J,"PSS224TX",3)="A problem was encountered when adding/verifying the new PUMP(S) entry in"
.S ^TMP($J,"PSS224TX",4)="your DOSE UNITS (#51.24) File. It is OK to install the remaining Mocha 2.1b"
.S ^TMP($J,"PSS224TX",5)="warranty patches, but contact the national help desk for assistance with this"
.S ^TMP($J,"PSS224TX",6)="Dose Unit problem. Refer to the PSS*1.0*224 patch installation in the ticket."
I PSSPUMRS D
.D BMES^XPDUTL("PUMP(S) successfully added to DOSE UNITS (#51.24) File...")
.S ^TMP($J,"PSS224TX",3)="The new Dose Unit of PUMP(S) was successfully added to your DOSE"
.S ^TMP($J,"PSS224TX",4)="UNITS (#51.24) File, no further action is necessary."
S XMSUB="PSS*1.0*224 Installation Complete"
S XMDUZ="PSS*1.0*224 Install"
S XMTEXT="^TMP($J,""PSS224TX"","
S XMY("G.PSS ORDER CHECKS")=""
I $G(DUZ) S XMY(DUZ)=""
N DIFROM D ^XMD
I $D(XMMG) D
.D BMES^XPDUTL("Problem sending mail message upon PSS*1*224 installation completion...")
.I 'PSSPUMRS D Q
..D BMES^XPDUTL("***Invalid PUMP(S) entry in your DOSE UNITS (#51.24) File...")
.D BMES^XPDUTL("PUMP(S) successfully added to DOSE UNITS (#51.24) File...")
K ^TMP($J,"PSS224TX")
Q
;
;
ADD() ;Add PUMP(S) to Dose Units File
;Quit with 0 if unable to add
D BMES^XPDUTL("Adding PUMP(S) to DOSE UNITS (#51.24) File...")
N PSSADPMP,PSSADIEN,XUMF
D KTMP S XUMF=""
S PSSADPMP(1,51.24,"+1,",.01)="PUMP(S)"
S PSSADPMP(1,51.24,"+1,",1)="PUMPS"
S PSSADPMP(1,51.24,"+1,",3)=1
S PSSADIEN(1)=54
D UPDATE^DIE("","PSSADPMP(1)","PSSADIEN") I $D(^TMP("DIERR",$J)) D KTMP Q 0
K PSSADPMP,PSSADIEN
I $P($G(^PS(51.24,54,0)),"^")'="PUMP(S)" Q 0
S PSSADIEN=54,XUMF=""
S PSSADPMP(1,51.242,"+2,"_PSSADIEN_",",.01)="PUMP"
D UPDATE^DIE("","PSSADPMP(1)")
I $D(^TMP("DIERR",$J)) D KTMP Q 0
D KTMP K XUMF
Q 1
;
;
KTMP ;Kill TMP error global
K ^TMP("DIERR",$J)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSS224PI 2961 printed Dec 13, 2024@02:29:31 Page 2
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
+2 ;
+3 QUIT
+4 ;
EN ;Check for PUMP(S) in DOSE UNITS File
+1 IF '$DATA(^PS(51.24,54))
IF '$$ADD
DO MAIL(0)
QUIT
+2 IF '$$VAL
DO MAIL(0)
QUIT
+3 DO MAIL(1)
+4 QUIT
+5 ;
+6 ;
VAL() ;Validate data
+1 DO BMES^XPDUTL("Validating PUMP(S) entry in DOSE UNITS (#51.24) File...")
+2 IF $GET(^PS(51.24,54,0))'="PUMP(S)^PUMPS^1"
QUIT 0
+3 IF $GET(^PS(51.24,54,1,1,0))'="PUMP"
QUIT 0
+4 IF '$DATA(^PS(51.24,54,1,"B","PUMP",1))
QUIT 0
+5 IF '$DATA(^PS(51.24,"B","PUMP(S)",54))
QUIT 0
+6 IF '$DATA(^PS(51.24,"C","PUMPS",54))
QUIT 0
+7 IF '$DATA(^PS(51.24,"D","PUMP",54,1))
QUIT 0
+8 IF '$DATA(^PS(51.24,"UPCASE","PUMP(S)",54))
QUIT 0
+9 QUIT 1
+10 ;
+11 ;
MAIL(PSSPUMRS) ;send mail message
+1 ;PSSPUMRS=0 - Problem adding PUMP(S)
+2 ;PSSPUMRS=1 - PUMP(S) added successfully
+3 NEW XMTEXT,XMY,XMSUB,XMDUZ,XMMG,XMSTRIP,XMROU,XMYBLOB,XMZ
+4 KILL ^TMP($JOB,"PSS224TX")
+5 SET ^TMP($JOB,"PSS224TX",1)="PSS*1.0*224 patch installation has completed."
SET ^TMP($JOB,"PSS224TX",2)=""
+6 IF 'PSSPUMRS
Begin DoDot:1
+7 DO BMES^XPDUTL("***Invalid PUMP(S) entry in your DOSE UNITS (#51.24) File...")
+8 SET ^TMP($JOB,"PSS224TX",3)="A problem was encountered when adding/verifying the new PUMP(S) entry in"
+9 SET ^TMP($JOB,"PSS224TX",4)="your DOSE UNITS (#51.24) File. It is OK to install the remaining Mocha 2.1b"
+10 SET ^TMP($JOB,"PSS224TX",5)="warranty patches, but contact the national help desk for assistance with this"
+11 SET ^TMP($JOB,"PSS224TX",6)="Dose Unit problem. Refer to the PSS*1.0*224 patch installation in the ticket."
End DoDot:1
+12 IF PSSPUMRS
Begin DoDot:1
+13 DO BMES^XPDUTL("PUMP(S) successfully added to DOSE UNITS (#51.24) File...")
+14 SET ^TMP($JOB,"PSS224TX",3)="The new Dose Unit of PUMP(S) was successfully added to your DOSE"
+15 SET ^TMP($JOB,"PSS224TX",4)="UNITS (#51.24) File, no further action is necessary."
End DoDot:1
+16 SET XMSUB="PSS*1.0*224 Installation Complete"
+17 SET XMDUZ="PSS*1.0*224 Install"
+18 SET XMTEXT="^TMP($J,""PSS224TX"","
+19 SET XMY("G.PSS ORDER CHECKS")=""
+20 IF $GET(DUZ)
SET XMY(DUZ)=""
+21 NEW DIFROM
DO ^XMD
+22 IF $DATA(XMMG)
Begin DoDot:1
+23 DO BMES^XPDUTL("Problem sending mail message upon PSS*1*224 installation completion...")
+24 IF 'PSSPUMRS
Begin DoDot:2
+25 DO BMES^XPDUTL("***Invalid PUMP(S) entry in your DOSE UNITS (#51.24) File...")
End DoDot:2
QUIT
+26 DO BMES^XPDUTL("PUMP(S) successfully added to DOSE UNITS (#51.24) File...")
End DoDot:1
+27 KILL ^TMP($JOB,"PSS224TX")
+28 QUIT
+29 ;
+30 ;
ADD() ;Add PUMP(S) to Dose Units File
+1 ;Quit with 0 if unable to add
+2 DO BMES^XPDUTL("Adding PUMP(S) to DOSE UNITS (#51.24) File...")
+3 NEW PSSADPMP,PSSADIEN,XUMF
+4 DO KTMP
SET XUMF=""
+5 SET PSSADPMP(1,51.24,"+1,",.01)="PUMP(S)"
+6 SET PSSADPMP(1,51.24,"+1,",1)="PUMPS"
+7 SET PSSADPMP(1,51.24,"+1,",3)=1
+8 SET PSSADIEN(1)=54
+9 DO UPDATE^DIE("","PSSADPMP(1)","PSSADIEN")
IF $DATA(^TMP("DIERR",$JOB))
DO KTMP
QUIT 0
+10 KILL PSSADPMP,PSSADIEN
+11 IF $PIECE($GET(^PS(51.24,54,0)),"^")'="PUMP(S)"
QUIT 0
+12 SET PSSADIEN=54
SET XUMF=""
+13 SET PSSADPMP(1,51.242,"+2,"_PSSADIEN_",",.01)="PUMP"
+14 DO UPDATE^DIE("","PSSADPMP(1)")
+15 IF $DATA(^TMP("DIERR",$JOB))
DO KTMP
QUIT 0
+16 DO KTMP
KILL XUMF
+17 QUIT 1
+18 ;
+19 ;
KTMP ;Kill TMP error global
+1 KILL ^TMP("DIERR",$JOB)
+2 QUIT
