- PSS129EN ;BIR/RTR-ENVIRONMENT CHECK ROUTINE FOR PSS*1*129 ;05/14/08
- ;;1.0;PHARMACY DATA MANAGEMENT;**129**;9/30/97;Build 67
- ;
- Q:'$G(XPDENV)
- ;
- EN ;
- N PSSVJMES,PSSVJAR,PSSVJARX,PSSVJLP,PSSVJFLG,DIC,DTOUT,DUOUT,X,Y,DIRUT,DIROUT,DIR
- S PSSVJMES(1)="Upon completion of the Post Install, a mail message will be sent"
- S PSSVJMES(2)="to the patch installer, and at least one pharmacy user. Please"
- S PSSVJMES(3)="enter one or more Pharmacy users (e.g., Pharmacy ADPAC or designee)"
- S PSSVJMES(4)="who should receive this message."
- D MES^XPDUTL(.PSSVJMES)
- S PSSVJAR(DUZ)=""
- S PSSVJFLG=0
- ;
- ASK ;
- D BMES^XPDUTL(" ")
- K DIC S DIC=200,DIC(0)="QEAMZ",DIC("A")="Enter Pharmacy User: "
- D ^DIC K DIC I $D(DTOUT)!($D(DUOUT))!(+Y'>0) G END
- I $D(PSSVJAR(+Y)) D BMES^XPDUTL("Already selected.") G ASK
- S PSSVJFLG=1
- S PSSVJAR(+Y)=""
- G ASK
- ;
- END ;
- I 'PSSVJFLG D BMES^XPDUTL("At least one pharmacy user must be selected. Install aborted.") S XPDABORT=2 Q
- D BMES^XPDUTL(" ")
- K DIR,Y S DIR(0)="Y",DIR("B")="Y",DIR("A")="Continue with install",DIR("?")="Enter 'Y' to continue with install, enter 'N' or '^' to abort install" D ^DIR K DIR
- I Y'=1!($D(DTOUT))!($D(DUOUT)) S XPDABORT=2 Q
- D BMES^XPDUTL(" ")
- F PSSVJLP=0:0 S PSSVJLP=$O(PSSVJAR(PSSVJLP)) Q:'PSSVJLP S @XPDGREF@("PSSVJARX",PSSVJLP)=""
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSS129EN 1327 printed Feb 18, 2025@23:55:12 Page 2
- PSS129EN ;BIR/RTR-ENVIRONMENT CHECK ROUTINE FOR PSS*1*129 ;05/14/08
- +1 ;;1.0;PHARMACY DATA MANAGEMENT;**129**;9/30/97;Build 67
- +2 ;
- +3 if '$GET(XPDENV)
- QUIT
- +4 ;
- EN ;
- +1 NEW PSSVJMES,PSSVJAR,PSSVJARX,PSSVJLP,PSSVJFLG,DIC,DTOUT,DUOUT,X,Y,DIRUT,DIROUT,DIR
- +2 SET PSSVJMES(1)="Upon completion of the Post Install, a mail message will be sent"
- +3 SET PSSVJMES(2)="to the patch installer, and at least one pharmacy user. Please"
- +4 SET PSSVJMES(3)="enter one or more Pharmacy users (e.g., Pharmacy ADPAC or designee)"
- +5 SET PSSVJMES(4)="who should receive this message."
- +6 DO MES^XPDUTL(.PSSVJMES)
- +7 SET PSSVJAR(DUZ)=""
- +8 SET PSSVJFLG=0
- +9 ;
- ASK ;
- +1 DO BMES^XPDUTL(" ")
- +2 KILL DIC
- SET DIC=200
- SET DIC(0)="QEAMZ"
- SET DIC("A")="Enter Pharmacy User: "
- +3 DO ^DIC
- KILL DIC
- IF $DATA(DTOUT)!($DATA(DUOUT))!(+Y'>0)
- GOTO END
- +4 IF $DATA(PSSVJAR(+Y))
- DO BMES^XPDUTL("Already selected.")
- GOTO ASK
- +5 SET PSSVJFLG=1
- +6 SET PSSVJAR(+Y)=""
- +7 GOTO ASK
- +8 ;
- END ;
- +1 IF 'PSSVJFLG
- DO BMES^XPDUTL("At least one pharmacy user must be selected. Install aborted.")
- SET XPDABORT=2
- QUIT
- +2 DO BMES^XPDUTL(" ")
- +3 KILL DIR,Y
- SET DIR(0)="Y"
- SET DIR("B")="Y"
- SET DIR("A")="Continue with install"
- SET DIR("?")="Enter 'Y' to continue with install, enter 'N' or '^' to abort install"
- DO ^DIR
- KILL DIR
- +4 IF Y'=1!($DATA(DTOUT))!($DATA(DUOUT))
- SET XPDABORT=2
- QUIT
- +5 DO BMES^XPDUTL(" ")
- +6 FOR PSSVJLP=0:0
- SET PSSVJLP=$ORDER(PSSVJAR(PSSVJLP))
- if 'PSSVJLP
- QUIT
- SET @XPDGREF@("PSSVJARX",PSSVJLP)=""
- +7 QUIT