- 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 Feb 18, 2025@23:55:34 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