PSNEN169 ;BIR/RTR-Environment Check routine for patch PSN*4*169 ;10/04/08
;;4.0;NATIONAL DRUG FILE;**169**; 30 Oct 98;Build 8
;
Q:'$G(XPDENV)
;
EN ;
N PSNVJMES,PSNVJAR,PSNVJARX,PSNVJLP,PSNVJFLG,DIC,DTOUT,DUOUT,X,Y,DIRUT,DIROUT,DIR
S PSNVJMES(1)="Upon completion of the Post Install, a mail message will be sent"
S PSNVJMES(2)="to the patch installer, and at least one pharmacy user. Please"
S PSNVJMES(3)="enter one or more Pharmacy users (e.g., Pharmacy ADPAC or designee)"
S PSNVJMES(4)="who should receive this message."
D MES^XPDUTL(.PSNVJMES)
S PSNVJAR(DUZ)=""
S PSNVJFLG=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(PSNVJAR(+Y)) D BMES^XPDUTL("Already selected.") G ASK
S PSNVJFLG=1
S PSNVJAR(+Y)=""
G ASK
;
END ;
I 'PSNVJFLG 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 PSNVJLP=0:0 S PSNVJLP=$O(PSNVJAR(PSNVJLP)) Q:'PSNVJLP S @XPDGREF@("PSNVJARX",PSNVJLP)=""
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSNEN169 1329 printed Dec 13, 2024@02:23:57 Page 2
PSNEN169 ;BIR/RTR-Environment Check routine for patch PSN*4*169 ;10/04/08
+1 ;;4.0;NATIONAL DRUG FILE;**169**; 30 Oct 98;Build 8
+2 ;
+3 if '$GET(XPDENV)
QUIT
+4 ;
EN ;
+1 NEW PSNVJMES,PSNVJAR,PSNVJARX,PSNVJLP,PSNVJFLG,DIC,DTOUT,DUOUT,X,Y,DIRUT,DIROUT,DIR
+2 SET PSNVJMES(1)="Upon completion of the Post Install, a mail message will be sent"
+3 SET PSNVJMES(2)="to the patch installer, and at least one pharmacy user. Please"
+4 SET PSNVJMES(3)="enter one or more Pharmacy users (e.g., Pharmacy ADPAC or designee)"
+5 SET PSNVJMES(4)="who should receive this message."
+6 DO MES^XPDUTL(.PSNVJMES)
+7 SET PSNVJAR(DUZ)=""
+8 SET PSNVJFLG=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(PSNVJAR(+Y))
DO BMES^XPDUTL("Already selected.")
GOTO ASK
+5 SET PSNVJFLG=1
+6 SET PSNVJAR(+Y)=""
+7 GOTO ASK
+8 ;
END ;
+1 IF 'PSNVJFLG
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 PSNVJLP=0:0
SET PSNVJLP=$ORDER(PSNVJAR(PSNVJLP))
if 'PSNVJLP
QUIT
SET @XPDGREF@("PSNVJARX",PSNVJLP)=""
+7 QUIT
