PSXPRE ;BIR/BAB-CMOP Pre-Initialization ;[ 02/22/96 1:09 PM ]
;;1.0;CONSOLIDATED MAIL OUTPATIENT PHARMACY;**3**;10 May 95
START S XQABT1=$H
I ^XMB("NETNAME")?1"CMOP-".E W !!,"Consolidated Mail Outpatient Pharmacy Install for Host Facility.",!!
I ^XMB("NETNAME")'?1"CMOP-".E W !!,"Consolidated Mail Outpatient Pharmacy Install for Remote Medical Center.",!!
DUZ S PSXDZ=$S(('($D(DUZ)#2)):1,'$D(^VA(200,DUZ,0)):1,'$D(DUZ(0)):1,DUZ(0)'="@":1,1:0) I PSXDZ=1 W !!,"You must be a valid user and ",!,"DUZ(0) must be set to the ""@"" sign!!",!! K DIFQ Q
CKDT I '$D(DT) S %DT="",X="T" D ^%DT S DT=Y
ASK I ^XMB("NETNAME")?1"CMOP-".E G CKU
I ($G(^PSX(550,0))["CMOP SYSTEM^550I")&($P($G(^PSX(550,0)),"^",3)>0) G CKU
W !!,*7,"This install of the Consolidated Mail Outpatient Pharmacy",!,"software at your medical center requires that you select the CMOP Host",!,"Facility which will be receiving your Outpatient Pharmacy prescription data.",!!
S DIR(0)="SX^B:BEDFORD;D:DALLAS;L:LEAVENWORTH;W:WEST LA",DIR("A")="Select the CMOP to RECEIVE YOUR DATA " D ^DIR K DIR
I "BDLW"'[$E(X) K DIFQ Q
S ^TMP("PSXCMOP",$J)="CMOP-"_$S($E(X)="L":"LEAV",$E(X)="B":"BED",$E(X)="D":"DAL",$E(X)="W":"WLA")_".DOMAIN.EXT"
CKU S PSX=0 I $D(DUZ),DUZ(0)="@",$D(DT),$D(U),PSXDZ=0 D RXC G QUIT:ERROR D ENV G DONE
QUIT ;
K DIFQ I $G(ERROR)=1 K PSX,PSXDZ,ERROR Q
DONE I $G(PSXDZ)=0,HOST=1,OP=0,NDF=1,KNL=1 S PSX=1
I $G(PSXDZ)=0,HOST=0,OP=1,NDF=1,KNL=1 S PSX=1
S:ERROR=1 PSX=0 K ERROR
K:PSX=0 DIFQ
K PSX,PKG,KNL,NDF,OP,HOST,PSXDZ,ERROR
S (XQABT2,XQABT3)=$H
Q
ENV ;
S (HOST,OP,NDF,KNL)=0
S:^XMB("NETNAME")?1"CMOP-".E HOST=1
I $D(^DIC(9.4,"B","OUTPATIENT PHARMACY")) S PKG=$O(^DIC(9.4,"B","OUTPATIENT PHARMACY",0)) S:$G(^DIC(9.4,+PKG,"VERSION"))="6.0" OP=1
I $D(^DIC(9.4,"B","KERNEL")) S PKG=$O(^DIC(9.4,"B","KERNEL",0)) S:$G(^DIC(9.4,+PKG,"VERSION"))'<7.1 KNL=1
I $D(^DIC(9.4,"B","NATIONAL DRUG FILE")) S PKG=$O(^DIC(9.4,"B","NATIONAL DRUG FILE",0)) S:$G(^DIC(9.4,+PKG,"VERSION"))["3.1" NDF=1
Q
RXC ;
I $P(^XMB("NETNAME"),"-")="CMOP" S ERROR=0 Q
W !!,"Validating required RX CONSULT FILE entries......"
I $G(^DIC(54,0,"GL"))'["^PS(54," W !!,"You must have Outpatient Pharmacy patch PSO*6*148 installed before installing CMOP Software.",!,"...INITIALIZATION ABORTED!",!! S ERROR=1 Q
K ^TMP("PSXDIC",$J),^TMP("PSXDD",$J),^TMP("PSXPS",$J)
S (ERROR,RXC)=0 I '$D(^PS(54)) W !!,"You do not have an RX CONSULT FILE........INITIALIZATION ABORTED!",!! S ERROR=1 Q
F X=1:1:20 S Y=$P($T(CON+X),";;",2) I $P(^PS(54,X,0),"^")'=Y S ERROR=1 W !,"Your RX CONSULT File entry # "_X_" is invalid.!!"
W:ERROR=1 !!,"INITIALIZATION ABORTED!",!! K RXC,X,Y
N %X,%Y S %X="^DIC(54,",%Y="^TMP(""PSXDIC"",$J," D %XY^%RCR
N %X,%Y S %X="^DD(54,",%Y="^TMP(""PSXDD"",$J," D %XY^%RCR
N %X,%Y S %X="^PS(54,",%Y="^TMP(""PSXPS"",$J," D %XY^%RCR
Q
CON ;
;;DROWSINESS
;;FINISH
;;EMPTY STOMACH
;;NO DAIRY PRODUCTS
;;WATER
;;DISCOLORATION
;;DIURETIC K
;;NO ALCOHOL
;;ADVICE
;;WITH FOOD
;;SUNLIGHT
;;SHAKE WELL
;;EXTERNAL
;;STRENGTH
;;REFRIGERATE
;;DUPLICATE
;;EXPIRATION DATE
;;NO REFILL
;;SAME DRUG
;;NO TRANSFER
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSXPRE 3146 printed Nov 22, 2024@16:54:53 Page 2
PSXPRE ;BIR/BAB-CMOP Pre-Initialization ;[ 02/22/96 1:09 PM ]
+1 ;;1.0;CONSOLIDATED MAIL OUTPATIENT PHARMACY;**3**;10 May 95
START SET XQABT1=$HOROLOG
+1 IF ^XMB("NETNAME")?1"CMOP-".E
WRITE !!,"Consolidated Mail Outpatient Pharmacy Install for Host Facility.",!!
+2 IF ^XMB("NETNAME")'?1"CMOP-".E
WRITE !!,"Consolidated Mail Outpatient Pharmacy Install for Remote Medical Center.",!!
DUZ SET PSXDZ=$SELECT(('($DATA(DUZ)#2)):1,'$DATA(^VA(200,DUZ,0)):1,'$DATA(DUZ(0)):1,DUZ(0)'="@":1,1:0)
IF PSXDZ=1
WRITE !!,"You must be a valid user and ",!,"DUZ(0) must be set to the ""@"" sign!!",!!
KILL DIFQ
QUIT
CKDT IF '$DATA(DT)
SET %DT=""
SET X="T"
DO ^%DT
SET DT=Y
ASK IF ^XMB("NETNAME")?1"CMOP-".E
GOTO CKU
+1 IF ($GET(^PSX(550,0))["CMOP SYSTEM^550I")&($PIECE($GET(^PSX(550,0)),"^",3)>0)
GOTO CKU
+2 WRITE !!,*7,"This install of the Consolidated Mail Outpatient Pharmacy",!,"software at your medical center requires that you select the CMOP Host",!,"Facility which will be receiving your Outpatient Pharmacy prescription data.",!!
+3 SET DIR(0)="SX^B:BEDFORD;D:DALLAS;L:LEAVENWORTH;W:WEST LA"
SET DIR("A")="Select the CMOP to RECEIVE YOUR DATA "
DO ^DIR
KILL DIR
+4 IF "BDLW"'[$EXTRACT(X)
KILL DIFQ
QUIT
+5 SET ^TMP("PSXCMOP",$JOB)="CMOP-"_$SELECT($EXTRACT(X)="L":"LEAV",$EXTRACT(X)="B":"BED",$EXTRACT(X)="D":"DAL",$EXTRACT(X)="W":"WLA")_".DOMAIN.EXT"
CKU SET PSX=0
IF $DATA(DUZ)
IF DUZ(0)="@"
IF $DATA(DT)
IF $DATA(U)
IF PSXDZ=0
DO RXC
if ERROR
GOTO QUIT
DO ENV
GOTO DONE
QUIT ;
+1 KILL DIFQ
IF $GET(ERROR)=1
KILL PSX,PSXDZ,ERROR
QUIT
DONE IF $GET(PSXDZ)=0
IF HOST=1
IF OP=0
IF NDF=1
IF KNL=1
SET PSX=1
+1 IF $GET(PSXDZ)=0
IF HOST=0
IF OP=1
IF NDF=1
IF KNL=1
SET PSX=1
+2 if ERROR=1
SET PSX=0
KILL ERROR
+3 if PSX=0
KILL DIFQ
+4 KILL PSX,PKG,KNL,NDF,OP,HOST,PSXDZ,ERROR
+5 SET (XQABT2,XQABT3)=$HOROLOG
+6 QUIT
ENV ;
+1 SET (HOST,OP,NDF,KNL)=0
+2 if ^XMB("NETNAME")?1"CMOP-".E
SET HOST=1
+3 IF $DATA(^DIC(9.4,"B","OUTPATIENT PHARMACY"))
SET PKG=$ORDER(^DIC(9.4,"B","OUTPATIENT PHARMACY",0))
if $GET(^DIC(9.4,+PKG,"VERSION"))="6.0"
SET OP=1
+4 IF $DATA(^DIC(9.4,"B","KERNEL"))
SET PKG=$ORDER(^DIC(9.4,"B","KERNEL",0))
if $GET(^DIC(9.4,+PKG,"VERSION"))'<7.1
SET KNL=1
+5 IF $DATA(^DIC(9.4,"B","NATIONAL DRUG FILE"))
SET PKG=$ORDER(^DIC(9.4,"B","NATIONAL DRUG FILE",0))
if $GET(^DIC(9.4,+PKG,"VERSION"))["3.1"
SET NDF=1
+6 QUIT
RXC ;
+1 IF $PIECE(^XMB("NETNAME"),"-")="CMOP"
SET ERROR=0
QUIT
+2 WRITE !!,"Validating required RX CONSULT FILE entries......"
+3 IF $GET(^DIC(54,0,"GL"))'["^PS(54,"
WRITE !!,"You must have Outpatient Pharmacy patch PSO*6*148 installed before installing CMOP Software.",!,"...INITIALIZATION ABORTED!",!!
SET ERROR=1
QUIT
+4 KILL ^TMP("PSXDIC",$JOB),^TMP("PSXDD",$JOB),^TMP("PSXPS",$JOB)
+5 SET (ERROR,RXC)=0
IF '$DATA(^PS(54))
WRITE !!,"You do not have an RX CONSULT FILE........INITIALIZATION ABORTED!",!!
SET ERROR=1
QUIT
+6 FOR X=1:1:20
SET Y=$PIECE($TEXT(CON+X),";;",2)
IF $PIECE(^PS(54,X,0),"^")'=Y
SET ERROR=1
WRITE !,"Your RX CONSULT File entry # "_X_" is invalid.!!"
+7 if ERROR=1
WRITE !!,"INITIALIZATION ABORTED!",!!
KILL RXC,X,Y
+8 NEW %X,%Y
SET %X="^DIC(54,"
SET %Y="^TMP(""PSXDIC"",$J,"
DO %XY^%RCR
+9 NEW %X,%Y
SET %X="^DD(54,"
SET %Y="^TMP(""PSXDD"",$J,"
DO %XY^%RCR
+10 NEW %X,%Y
SET %X="^PS(54,"
SET %Y="^TMP(""PSXPS"",$J,"
DO %XY^%RCR
+11 QUIT
CON ;
+1 ;;DROWSINESS
+2 ;;FINISH
+3 ;;EMPTY STOMACH
+4 ;;NO DAIRY PRODUCTS
+5 ;;WATER
+6 ;;DISCOLORATION
+7 ;;DIURETIC K
+8 ;;NO ALCOHOL
+9 ;;ADVICE
+10 ;;WITH FOOD
+11 ;;SUNLIGHT
+12 ;;SHAKE WELL
+13 ;;EXTERNAL
+14 ;;STRENGTH
+15 ;;REFRIGERATE
+16 ;;DUPLICATE
+17 ;;EXPIRATION DATE
+18 ;;NO REFILL
+19 ;;SAME DRUG
+20 ;;NO TRANSFER
