PSO254EN ;BHAM-ISC/MFR - ENVIRONMENT CHECK ROUTINE FOR PATCH PSO*7*254 ;10/03/06
;;7.0;OUTPATIENT PHARMACY;**254**;DEC 1997;Build 19
;Reference to $$PROD^XPROD supported by IA 4440
;Reference to NEW PERSON file (#200) supported by IA 224
;Reference to BMES^XPDUTL supported by IA 10141
;
Q:'$G(XPDENV) S XPDABORT=0
;
I $$PROD^XUPROD(),'$$FIND1^DIC(4,,"B","LEAVENWORTH PHARMACY") D Q
. S XPDQUIT=1 D BMES^XPDUTL("THE POST-INSTALL FOR XU*8*416 HAS NOT COMPLETED AND/OR RUN. TRY AGAIN LATER!")
;
W !
W !," The post-install routine included with this patch will send out a"
W !," Mailman message with the list of Pharmacy Divisions in your site"
W !," along with their related National Provider Identifier (NPI)"
W !," Institution, which is being automatically assigned by this patch."
W !," "
W !," It will also indicate if there were problems in the automatic"
W !," assignment, which will have to be followed-up by an Outpatient"
W !," Pharmacy user as outlined in the patch description."
W !," "
W !," So, please enter the Outpatient Pharmacy user(s) (e.g., Pharmacy"
W !," ADPAC or designee) who should receive this message (at least 1 user"
W !," is required). The user entered should be the person responsible for"
W !," the maintenance of the PSO Site Parameters. The message will also"
W !," be sent to the user installing the patch."
W !
;
N ARRAY,DIC,DTOUT,DUOUT,QT,Y,X,I,USR
S DIC=200,DIC(0)="QEZAM",DIC("A")="PHARMACY USER: "
F D ^DIC Q:X="" D Q:$G(QT)
. I $D(DTOUT)!$D(DUOUT) K ARRAY S QT=1 Q
. W " ",$P(Y,"^",2),$S($D(ARRAY(+Y)):" (already selected)",1:"")
. W ! S ARRAY(+Y)="",DIC("A")="ANOTHER ONE: "
;
I '$D(ARRAY) D S XPDABORT=2 Q
. D BMES^XPDUTL("AT LEAST ONE PHARMACY USER MUST BE ENTERED FOR THIS PATCH TO BE INSTALLED!")
;
S @XPDGREF@("PSO254USR0")=DUZ
S USR="" F I=1:1 S USR=$O(ARRAY(USR)) Q:USR="" S @XPDGREF@("PSO254USR"_I)=USR
;
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSO254EN 2008 printed Apr 09, 2024@21:33:06 Page 2
PSO254EN ;BHAM-ISC/MFR - ENVIRONMENT CHECK ROUTINE FOR PATCH PSO*7*254 ;10/03/06
+1 ;;7.0;OUTPATIENT PHARMACY;**254**;DEC 1997;Build 19
+2 ;Reference to $$PROD^XPROD supported by IA 4440
+3 ;Reference to NEW PERSON file (#200) supported by IA 224
+4 ;Reference to BMES^XPDUTL supported by IA 10141
+5 ;
+6 if '$GET(XPDENV)
QUIT
SET XPDABORT=0
+7 ;
+8 IF $$PROD^XUPROD()
IF '$$FIND1^DIC(4,,"B","LEAVENWORTH PHARMACY")
Begin DoDot:1
+9 SET XPDQUIT=1
DO BMES^XPDUTL("THE POST-INSTALL FOR XU*8*416 HAS NOT COMPLETED AND/OR RUN. TRY AGAIN LATER!")
End DoDot:1
QUIT
+10 ;
+11 WRITE !
+12 WRITE !," The post-install routine included with this patch will send out a"
+13 WRITE !," Mailman message with the list of Pharmacy Divisions in your site"
+14 WRITE !," along with their related National Provider Identifier (NPI)"
+15 WRITE !," Institution, which is being automatically assigned by this patch."
+16 WRITE !," "
+17 WRITE !," It will also indicate if there were problems in the automatic"
+18 WRITE !," assignment, which will have to be followed-up by an Outpatient"
+19 WRITE !," Pharmacy user as outlined in the patch description."
+20 WRITE !," "
+21 WRITE !," So, please enter the Outpatient Pharmacy user(s) (e.g., Pharmacy"
+22 WRITE !," ADPAC or designee) who should receive this message (at least 1 user"
+23 WRITE !," is required). The user entered should be the person responsible for"
+24 WRITE !," the maintenance of the PSO Site Parameters. The message will also"
+25 WRITE !," be sent to the user installing the patch."
+26 WRITE !
+27 ;
+28 NEW ARRAY,DIC,DTOUT,DUOUT,QT,Y,X,I,USR
+29 SET DIC=200
SET DIC(0)="QEZAM"
SET DIC("A")="PHARMACY USER: "
+30 FOR
DO ^DIC
if X=""
QUIT
Begin DoDot:1
+31 IF $DATA(DTOUT)!$DATA(DUOUT)
KILL ARRAY
SET QT=1
QUIT
+32 WRITE " ",$PIECE(Y,"^",2),$SELECT($DATA(ARRAY(+Y)):" (already selected)",1:"")
+33 WRITE !
SET ARRAY(+Y)=""
SET DIC("A")="ANOTHER ONE: "
End DoDot:1
if $GET(QT)
QUIT
+34 ;
+35 IF '$DATA(ARRAY)
Begin DoDot:1
+36 DO BMES^XPDUTL("AT LEAST ONE PHARMACY USER MUST BE ENTERED FOR THIS PATCH TO BE INSTALLED!")
End DoDot:1
SET XPDABORT=2
QUIT
+37 ;
+38 SET @XPDGREF@("PSO254USR0")=DUZ
+39 SET USR=""
FOR I=1:1
SET USR=$ORDER(ARRAY(USR))
if USR=""
QUIT
SET @XPDGREF@("PSO254USR"_I)=USR
+40 ;
+41 QUIT
