source: WorldVistAEHR/trunk/r/PHARMACY_PRESCRIPTION_PRACTICE-PPP/PPPBFFX.m@ 846

Last change on this file since 846 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.0 KB
RevLine 
[613]1PPPBFFX ;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.",!
25QCDTST 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 ;
30ASK1 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 ;
35PPPBGN ;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
42DEVICE 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 ;
47TSKMAN ;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
56QNOBLD W !!,"No build could be performed.",!
57Q 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
Note: See TracBrowser for help on using the repository browser.