source: FOIAVistA/trunk/r/PHARMACY_PRESCRIPTION_PRACTICE-PPP/PPPMPI.m@ 649

Last change on this file since 649 was 628, checked in by George Lilly, 16 years ago

initial load of FOIAVistA 6/30/08 version
File size: 4.9 KB
Line 
1PPPMPI ;BHM/DB - OBTAIN VISIT DATA FROM MPI ;21NOV01
2 ;;1.0;PHARMACY PRESCRIPTION PRACTICE;**35,39,41**;APR 7, 1995
3 ;
4 ;Reference to ^DPT("SSN" are covered by IA# 350
5 ;Reference to ^DIC(4) are covered by IA# 10090
6 D DONE
7 S (PPPCNT,PPPCNT1)=0
8 ;This routine extracts patient data from the
9 ;Treating Facility List file (#391.91)
10 ;^DGCN(391.91,D0,0) =
11 ;(#.01) PATIENT [1P] ^ (#.02) INSTITUTION [2P] ^
12 ;(#.03) DATE LAST TREATED [3D]
13 ;
14 W @IOF,!!,?20,"Build Foreign Facility Cross Reference",!
15 ;I '$D(^DGCN(391.91)) W !,"Sorry could not find the TREATING FACILITY LIST file (#391.91).",! G Q
16DATE ;Check for last build date
17 S PPPDUZ=DUZ
18 I $P($G(^PPP(1020.1,1,0)),"^",4)'>0 W !,"Could not find last build date." G ASKDT
19 S (PPPDT,Y)=$P($G(^PPP(1020.1,1,0)),"^",4) I +Y>0 X ^DD("DD") S PPPDT(1)=Y W !,"This option was last run on "_PPPDT(1)
20ASKDT S %DT("A")="Start searching from what date? " I $G(PPPDT)'="" S %DT(0)=PPPDT,%DT("B")=PPPDT(1)
21 S %DT="AE" D ^%DT G DONE:$G(DTOUT)=1 G DONE:+Y'>0 S PPPSTDT=+Y
22PPPSSN ;CHECK SSN
23 ;First check for Last SSN processed
24 S PPPSSN=$P($G(^PPP(1020.1,1,2)),"^",1) I PPPSSN="" S PPPSSN=0 G TSKMAN
25 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 TSKMAN
26 ;
27ASK1 W !,"Do you want to start this extract at SSN : ",PPPSSN," ? NO// " R AN:DTIME G DONE:AN["^" I AN="" S AN="N"
28 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
29 I "Yy"[AN G TSKMAN
30 I "Nn"[AN W !!,"OK, we'll start at the beginning." S PPPSSN=0
31TSKMAN ;Call taskman
32 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 DONE:$D(DIRUT)
33 F X="PPPSTDT","PPPRCVD","PPPDUZ","PPPSSN","PPPDT" S ZTSAVE(X)=""
34 S ZTDTH=Y,ZTRTN="PPPBGN^PPPMPI",ZTDESC="FFX BUILD FROM CD ROM",ZTIO=""
35 D ^%ZTLOAD
36 I '$D(ZTSK) D HOME^%ZIS W !,"Task was not started properly.",! G DONE
37 W !!,"Task Queued - Task Number: ",ZTSK,!!
38 G DONE
39 ;
40PPPBGN ;Entry point for building FFX file
41 N PPPDLUP
42 D NOW^%DTC S Y=%,PPPDLUP=$P(Y,".") X ^DD("DD") S PPPSTRT=Y,(PPPCNTR,PPPVSTC,PPPEND,PPPCNT,PPPENDT)=0
43 S PPPCNTR=0,PPPSSN1=PPPSSN F S PPPSSN1=$O(^DPT("SSN",PPPSSN1)) Q:PPPSSN1="" S PPPCNTR=$G(PPPCNTR)+1
44 ;
45 ;
46PPPLOOP S PPPSSN=$O(^DPT("SSN",PPPSSN)) G Q:$G(PPPSSN)="" S PPPCNT=$G(PPPCNT)+1,PPPDFN=+$$GETDFN^PPPGET1(PPPSSN) I $G(PPPDFN)'>0 G PPPLOOP
47 S ^PPP(1020.1,1,2)=PPPSSN,PPPEND=PPPSSN
48 K PPPDATA D TFL^VAFCTFU1(.PPPDATA,PPPDFN) ;Supported IA #2990
49 S PPPX1=0
501 S PPPX1=$O(PPPDATA(PPPX1)) G PPPLOOP:PPPX1'>0 S DATA=PPPDATA(PPPX1),PPPVSTC=$G(PPPVSTC)+1
51 I $P(DATA,"^",5)'="VAMC" G 1
52 S PPPSITE=$P(DATA,"^",1) I $D(^PPP(1020.5,"B",PPPSITE)) G 1
53 I PPPSITE=$P($G(^PPP(1020.1,1,0)),"^",9) G 1
54 ;get visit information & update 1020.2
55 S PPPVST=$P($P(DATA,"^",3),".") I $G(PPPVST)<PPPSTDT G 1
56 ;
57MTCH ;Site data already exist for SSN
58 ;VMP OIFO BAY PINES;VGF;PPP*1.0*39;STORE INSTITUTION FILE IEN INTO PLACE OF VISIT FIELD OF 1020.2
59 K PPPIIEN
60 S PPPIIEN=$O(^DIC(4,"D",PPPSITE,0))
61 S PPPUPDT=0,PPPIEN1=$O(^PPP(1020.2,"APOV",PPPDFN,PPPIIEN,""))
62 I $G(PPPIEN1)>0 S PPPOLDDT=$P($G(^PPP(1020.2,PPPIEN1,0)),"^",3) D
63 .I $G(PPPOLDDT)'="",PPPVST>PPPOLDDT K DIE,DR S DIE="^PPP(1020.2,",DA=PPPIEN1,DR="2///"_PPPVST D ^DIE K DIE,DR,DA S PPPUPDT=1
64 .;VMP OIFO BAY PINES;PPP*1*41
65 .;ADDED NEXT LINE VISIT DATE CAN BE NULL IF ADDED BY PDX TRANSACTION IN PPPPDX3
66 .I $G(PPPOLDDT)="",PPPVST>0 K DIE,DR S DIE="^PPP(1020.2,",DA=PPPIEN1,DR="2///"_PPPVST D ^DIE K DIE,DR,DA S PPPUPDT=1
67 I $G(PPPUPDT)=1 G 1
68 I $G(PPPIEN1)>0 G 1
69 ;
70 ;
71 ;
72NEWSSN ;Add patient to 1020.2
73 S X=PPPDFN,DLAYGO="1020.2",DIC="^PPP(1020.2,",DIC(0)="",DIC("DR")="1////"_PPPIIEN_";2///"_PPPVST_";7///0" K DD,D0 D FILE^DICN
74 G 1
75Q ;
76 ;VMP OIFO BAY PINES;PPP*1*41
77 ;ADDED NEXT LINE TO UPDATE LAST PDX BATCH DATE IN PARAMETER FILE
78 K DIE,DR S DIE="^PPP(1020.1,",DA=1,DR="3///"_PPPDLUP D ^DIE K DIE,DR,DA
79 K DIC
80 D NOW^%DTC S Y=% X ^DD("DD") S PPPENDT=Y
81 S ^TMP($J,"PPP",1)=" "
82 S ^TMP($J,"PPP",2)=" RESULTS FROM BUILD PROCESS"
83 S ^TMP($J,"PPP",3)=" Build Started at : "_$G(PPPSTRT)
84 S ^TMP($J,"PPP",4)=" Build Finished at : "_$G(PPPENDT)
85 S ^TMP($J,"PPP",5)=" Last SSN processed : "_$G(PPPEND) I $O(^DPT("SSN",PPPEND))="" S ^TMP($J,"PPP",5)=^TMP($J,"PPP",5)_" << Last SSN on file."
86 S ^TMP($J,"PPP",6)=" Processed "_$G(PPPCNT)_" out of "_$G(PPPCNTR)_" SSNs."
87 S ^TMP($J,"PPP",7)=" Examined "_$G(PPPVSTC)_" site visits"
88 ;
89 ;
90SNDMAIL ;Send message to user
91 S XMSUB="PHARMACY PRESCRIPTION PRACTICES",XMTEXT="^TMP("_$J_","_"""PPP"""_",",XMDUZ=.5,XMY(PPPDUZ)="" D ^XMD K XMDUZ
92 K ^TMP($J)
93DONE ;kill variables & exit
94 K AN,DA,DATA,DD,DIC,DIE,DIR,DR,OLDDT,PPPCNT,PPPCNT1,PPPCNTR,PPPDATA,PPPDFN,PPPDT,PPPDUZ,PPPEND,PPPENDT,PPPIEN1,PPPSITE,PPPSSN,PPPSSN1,PPPSTDT,PPPSTRT,PPPUPDT,PPPVST,PPPVSTC,PPPX1
95 K X,XMDUZ,XMY,Y Q
Note: See TracBrowser for help on using the repository browser.