source: WorldVistAEHR/trunk/r/PHARMACY_PRESCRIPTION_PRACTICE-PPP/PPPBFFX1.m@ 1046

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

initial load of WorldVistAEHR
File size: 4.2 KB
Line 
1PPPBFFX1 ;BHM/DB-Build off of CD_ROM continued ;3JUL97
2 ;;1.0;PHARMACY PRESCRIPTION PRACTICE;**11,16,17,21,26**;APR 7, 1995
3 K CNTR1,MAILERR,CNTR2,^TMP("PPP SORT",$J),PPPEND
4PPPSTRT ;Starting point for extraction process
5 ;@references to variable names generally represent extended globals
6 ;@EXCARR@ = ["DEV","VAA"]^TMP("PPP",$J,"EXCLUDE")
7 ;@MPDARR@ = ["DEV","VAA"]^TMP("PPP",$J,"RESULTS")
8 ;@SORTSSN@ = ["DEV","VAA"]^DPT("SSN")
9 ;@SSNARR@ = ["DEV","VAA"]^TMP("PPP",$J,"SSN")
10 S PPP1=$G(^PPP(1020.1,1,1)),PPP0=$G(^PPP(1020.1,1,0))
11 D NOW^%DTC S TODAY=$P(%,".") D YX^%DTC S STRTTM=Y
12 K ERRTXT,DMNNEW,SSNCNT,Y,PATCHK,PATCHG,PATADD,SITECNT
13 K ^TMP($J) D TXT S ^TMP($J,"PPPERR",ERRTXT)=" BUILD FOREIGN FACILITY CROSS REFERENCE FILE"
14 S INUCI=$P(PPP1,"^"),OUTUCI=$P(PPP1,"^",2),PPPSTANO=$P(PPP0,"^",9)
15 S XX="["""_$E(INUCI,1,3)_""","""_$E(INUCI,5,7)_"""]"
16 S SORTSSN="^"_XX_"DPT("_"""SSN"""_")"
17 S SSNARR="^"_XX_"TMP(""PPP"","_$J_",""SSN"")"
18 S XX="["""_$E(OUTUCI,1,3)_""","""_$E(OUTUCI,5,7)_"""]"
19 S MPDARR="^"_XX_"TMP(""PPP"","_$J_",""RESULTS"")"
20 S EXCARR="^"_XX_"TMP(""PPP"","_$J_",""EXCLUDE"")"
21 S KLLARRAY="^"_XX_"TMP(""PPP"")" S X=0 F S X=$O(@KLLARRAY@(X)) Q:X="" K @KLLARRAY@(X)
22 S X=0 F S X=$O(@MPDARR@(X)) Q:X="" K @MPDARR@(X)
23 S @EXCARR@(PPPSTANO)=""
24 ;
251 ;
26 S MAXTM=1000,STARTTM=$$NOW^PPPCNV1 ;Max time = 10 minutes
27 F S PPPSSN=$O(@SORTSSN@(PPPSSN)) Q:PPPSSN="" S CNTR1=$G(CNTR1)+1,^TMP("PPP SORT",CNTR1)=PPPSSN,PPPEND=PPPSSN
28 K CNTR,CNTR2,SSNCNT,PATCHK,PATCHG,PATADD,SITECNT,DMNNEW
292 S CNTR=$G(CNTR)+1,CNTR2=$G(CNTR2)+1,PPPSSN=$G(^TMP("PPP SORT",CNTR)) G 3:$G(PPPSSN)="" S @SSNARR@(PPPSSN)="",PPPEND=PPPSSN I $G(CNTR2)=100 G 3
30 G 2
313 S X=0 F S X=$O(@MPDARR@(X)) Q:X="" K @MPDARR@(X)
32 S STARTTM=$$NOW^PPPCNV1 G:$G(CNTR2)=1 FINI S X="VAMPAPI0" X ^%ZOSF("TEST") I $T S ERR=$$MPD^VAMPAPI0(SSNARR,MPDARR,"MPD**00001",EXCARR,600,1)
33 I +ERR<0 S ERRTXT=$G(ERRTXT)+1,^TMP($J,"PPPERR",ERRTXT)="Error : "_$P(ERR,"^",2) G FINI
344 I $D(@MPDARR@("DONE",PPPEND)) K PPPSSN G BGN
35 I $$DIFFTM^PPPCNV1($$NOW^PPPCNV1,STARTTM)>MAXTM S ERRTEXT=$G(ERRTXT)+1,^TMP($J,"PPPERR",ERRTXT)=" Timed out waiting for server to transfer data" S MAILERR=1 G FINI
36 H .5 G 4
37BGN ;begin compilation of data
38 S PPPSSN=$S('$D(PPPSSN):$O(@MPDARR@("DONE",0)),1:$O(@MPDARR@("DONE",PPPSSN))) G NXTBTCH:PPPSSN="" S SSNCNT=$G(SSNCNT)+1
39 S $P(^PPP(1020.1,1,2),"^",1)=PPPSSN
40 I '$D(@MPDARR@(PPPSSN,"FOUND")) G BGN
41 I @MPDARR@(PPPSSN,"FOUND")'>0 G BGN
42 S PATDFN=$O(@SORTSSN@(PPPSSN,0)) I $G(PATDFN)'>0 G BGN
43 S PPPSITE=0
44FAC ;Get facilities visited
45 S PPPSITE=$O(@MPDARR@(PPPSSN,"SITES",PPPSITE)) G BGN:PPPSITE'>0 K PPPERR1 D
46 .;Get internal ien for station & domain name
47 .I $D(^PPP(1020.5,"B",PPPSITE)) S PPPERR1=1 Q
48 .I $D(^PPP(1020.8,"B",PPPSITE)) S PPPIEN=$O(^PPP(1020.8,"B",PPPSITE,0)),DMNNAME=$P($G(^PPP(1020.8,PPPIEN,0)),"^",2) Q
49 .I $D(^PPP(1020.8,"D",PPPSITE)) S PPPIEN=$O(^PPP(1020.8,"D",PPPSITE,0)),DMNNAME=$P($G(^PPP(1020.8,PPPIEN,0)),"^",2) Q
50 .I $D(^PPP(1020.8,PPPSITE)) S PPPIEN=PPPSITE Q
51 .S DIC="^DIC(4,",DIC(0)="QMZ",X=PPPSITE,D="D" D IX^DIC I $D(Y),Y>0 S PPPIEN=+Y I $D(^PPP(1020.8,PPPIEN)) S DMNNAME=$P($G(^PPP(1020.8,PPPIEN,0)),"^",2)
52 I $G(PPPERR1)=1 K PPPERR1 G FAC
53 S PPPIEN=$S($G(PPPIEN)'="":PPPIEN,1:PPPSITE)
54 S:$G(DMNNAME)="" DMNNAME=""
55 S LNUM=0 I $G(DMNNAME)]"" S LNUM=$O(^PPP(1020.128,"A",DMNNAME,0))
56 I LNUM S DMNNAME=$P(^PPP(1020.128,LNUM,0),"^",2),DMNNEW=$G(DMNNEW)+1
57 ;
58UPDATE ;new entry or update old
59 S X=@MPDARR@(PPPSSN,"SITES",PPPSITE),%DT="" D ^%DT S LSTVISIT=Y K X,UPDATE1
60 I $G(DMNNAME)'="",$D(^PPP(1020.2,"AC",PATDFN,DMNNAME)) S PPPIEN1=$O(^PPP(1020.2,"AC",PATDFN,DMNNAME,0)) D
61 .Q:$G(PPPIEN1)'>0
62 .S OLDDT=$P($G(^PPP(1020.2,PPPIEN1,0)),"^",3) ;Date of last visit
63 .I LSTVISIT>OLDDT S DIE="^PPP(1020.2,",DA=PPPIEN1,DR="2///"_LSTVISIT D ^DIE K DR,DIE
64 .S UPDATE1=1 Q
65 I $G(UPDATE1)=1 G FAC ;get next facility visited
66NEWSSN ;
67 S X=PATDFN,DIC="^PPP(1020.2,",DIC(0)="",DIC("DR")="1////"_PPPIEN_";2///"_LSTVISIT_";7///0" K DD,D0 D FILE^DICN
68 G FAC
69 ;
70FINI ;Done
71 G ^PPPBFFX2
72Q D Q^PPPBFFX K ^TMP($J) Q
73 S X=0 F S X=$O(@KLLARRAY@(X)) Q:X="" K @KLLARRAY@(X)
74 K X,KLLARRAY Q
75TXT S ERRTXT=$G(ERRTXT)+1 Q
76NXTBTCH S X=0 F S X=$O(@SSNARR@(X)) Q:X="" K @SSNARR@(X)
77 S X=0 F S X=$O(@MPDARR@(X)) Q:X="" K @MPDARR@(X),@MPDARR@("DONE",X)
78 S CNTR2=0
79 G 2
Note: See TracBrowser for help on using the repository browser.