1 | PPPBFFX ;BHM/DB-PPP/BUILD FOREIGN FACILITY XREF ;4MAR97
|
---|
2 | ;;1.0;PHARMACY PRESCRIPTION PRACTICE;**11,26**;APR 7, 1995
|
---|
3 | ;
|
---|
4 | ;@references to variable names generally represent extended globals
|
---|
5 | ;i.e., in this routine:
|
---|
6 | ;@GBLCHK1 = ["PPS","VAH"]^VAM(394.94,"1","RUN")
|
---|
7 | ;
|
---|
8 | K ^TMP("PPP",$J),^TMP($J) D Q
|
---|
9 | K CNT,CNTR,PPPSSN,^TMP("PPP",$J)
|
---|
10 | ;
|
---|
11 | W !!,"First let me check the status of the CD-ROM Server.",! H 2
|
---|
12 | S SVRLOC=$O(^VAM(394.99,"A-UCIVOL",""))
|
---|
13 | I SVRLOC="" W !,"Cannot find a location for the server." S ERR=1 G QNOBLD
|
---|
14 | S GLBLOC=SVRLOC_"VAM("
|
---|
15 | S GBLCHK1=GLBLOC_394.94_",1,"_"""RUN"""_")"
|
---|
16 | S TMP=@GBLCHK1
|
---|
17 | I TMP="" W !,"Could not get status of server." S ERR=1 G QNOBLD
|
---|
18 | I +TMP'=1 W !,$P(TMP,"^",3) S ERR=1 G QNOBLD
|
---|
19 | I +$P(TMP,"^",2) W !,"CD-ROM is in process of stopping." G QNOBLD
|
---|
20 | ;
|
---|
21 | ;Check for other jobs
|
---|
22 | S GBLCHK1=GLBLOC_394.98_",1,"_"""POST"""_")"
|
---|
23 | S PST=@GBLCHK1 I $P(PST,"^")'=0 W !,"Another request is already made.",! S ERR=1 G QNOBLD
|
---|
24 | W !!,"Everything appears ok with the server, please proceed.",!
|
---|
25 | QCDTST K SVRLOC,GLBLOC,GBLCHK1,TMP,PST I $D(ERR) K ERR G QNOBLD
|
---|
26 | ;First check for Last SSN processed
|
---|
27 | S PPPSSN=$P($G(^PPP(1020.1,1,2)),"^",1) I PPPSSN="" S PPPSSN=0 G PPPBGN
|
---|
28 | I $O(^DPT("SSN",PPPSSN))="" W !!,?10,"The last SSN processed (",PPPSSN,") is the last in the file.",!,?10,"therefore, we will start the extract from the beginning.",! S PPPSSN=0 G PPPBGN
|
---|
29 | ;
|
---|
30 | ASK1 W !,"Do you want to start this extract at SSN : ",PPPSSN," ? NO// " R AN:DTIME I AN="" S AN="N"
|
---|
31 | I "YyNn"'[AN W !!,?10,"Answer Y and the report will commence with the next SSN.",!,?10,"Answer 'N' and the process will start with the first SSN on file.",! K AN G ASK1
|
---|
32 | I "Yy"[AN G PPPBGN
|
---|
33 | I "Nn"[AN W !!,"OK, we'll start at the beginning." S PPPSSN=0
|
---|
34 | ;
|
---|
35 | PPPBGN ;start this puppy rolling
|
---|
36 | S PPP1=$G(^PPP(1020.1,1,1)),PPP0=$G(^PPP(1020.1,1,0))
|
---|
37 | W !!,"First let me check a few things...."
|
---|
38 | I $P(PPP1,"^")="" W !!,"No entry for the `LOCATION OF DPT GLOBAL'." G QNOBLD
|
---|
39 | ;
|
---|
40 | I $P(PPP1,"^",2)="" W !,"No entry for the `LOCATION OF TMP GLOBAL'." G QNOBLD
|
---|
41 | I $P($G(^PPP(1020.1,1,0)),"^",9)="" W !!,"Station number not found in parameter file.",! G QNOBLD
|
---|
42 | DEVICE K DIR S DIR(0)="YA",DIR("A")="Create new Foreign Facility Cross Reference from CD: "
|
---|
43 | S DIR("B")="NO",DIR("?")="Enter yes to create new FFX from CD."
|
---|
44 | D ^DIR I Y G TSKMAN
|
---|
45 | G QNOBLD
|
---|
46 | ;
|
---|
47 | TSKMAN ;Call taskman
|
---|
48 | W ! K DIR S DIR(0)="DA^NOW::ERSX",DIR("A")="When do you want to run this utility? ",DIR("B")="NOW",DIR("?")="Complete data and time must be stated." D ^DIR G Q:$D(DIRUT)
|
---|
49 | S PPPRCVD=DUZ,ZTSAVE("PPPRCVD")="",ZTSAVE("PPPSSN")=""
|
---|
50 | S ZTDTH=Y,ZTRTN="^PPPBFFX1",ZTDESC="FFX BUILD FROM CD ROM",ZTIO=""
|
---|
51 | D ^%ZTLOAD
|
---|
52 | I '$D(ZTSK) D HOME^%ZIS W !,"Task was not started properly.",! G QNOBLD
|
---|
53 | W !!,"Task Queued - Task Number: ",ZTSK,!!
|
---|
54 | Q
|
---|
55 | G ^PPPBFFX1
|
---|
56 | QNOBLD W !!,"No build could be performed.",!
|
---|
57 | Q K AN,CNT,CNTR,DA,DIE,DMNNAME,DMNNEW,ERR,ERRTXT,EXCARR,FACADD,IFN,INUCI,LNUM,LSTVISIT,MPDARR,OUTUCI,PATADD,PATCHG,PATCHK,PPP0,PPP1,PPPRCVD,PPPSSN,STATUS,STRTTM,TMP2
|
---|
58 | K PATDFN,PPP,PPP0,PPP1,PPPSSN,PPPSTANO,SITE,SITEADD,SITECNT,SSN,SSNARR,SSNCNT,STAT,STRTM,TODAY,X,XX,Y,MAILERR,CNTR1,CNTR2,PPPEND,MAILERR Q
|
---|