| [613] | 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 | 
|---|