80 lines
4.2 KiB
Mathematica
80 lines
4.2 KiB
Mathematica
PPPBFFX1 ;BHM/DB-Build off of CD_ROM continued ;3JUL97
|
|
;;1.0;PHARMACY PRESCRIPTION PRACTICE;**11,16,17,21,26**;APR 7, 1995
|
|
K CNTR1,MAILERR,CNTR2,^TMP("PPP SORT",$J),PPPEND
|
|
PPPSTRT ;Starting point for extraction process
|
|
;@references to variable names generally represent extended globals
|
|
;@EXCARR@ = ["DEV","VAA"]^TMP("PPP",$J,"EXCLUDE")
|
|
;@MPDARR@ = ["DEV","VAA"]^TMP("PPP",$J,"RESULTS")
|
|
;@SORTSSN@ = ["DEV","VAA"]^DPT("SSN")
|
|
;@SSNARR@ = ["DEV","VAA"]^TMP("PPP",$J,"SSN")
|
|
S PPP1=$G(^PPP(1020.1,1,1)),PPP0=$G(^PPP(1020.1,1,0))
|
|
D NOW^%DTC S TODAY=$P(%,".") D YX^%DTC S STRTTM=Y
|
|
K ERRTXT,DMNNEW,SSNCNT,Y,PATCHK,PATCHG,PATADD,SITECNT
|
|
K ^TMP($J) D TXT S ^TMP($J,"PPPERR",ERRTXT)=" BUILD FOREIGN FACILITY CROSS REFERENCE FILE"
|
|
S INUCI=$P(PPP1,"^"),OUTUCI=$P(PPP1,"^",2),PPPSTANO=$P(PPP0,"^",9)
|
|
S XX="["""_$E(INUCI,1,3)_""","""_$E(INUCI,5,7)_"""]"
|
|
S SORTSSN="^"_XX_"DPT("_"""SSN"""_")"
|
|
S SSNARR="^"_XX_"TMP(""PPP"","_$J_",""SSN"")"
|
|
S XX="["""_$E(OUTUCI,1,3)_""","""_$E(OUTUCI,5,7)_"""]"
|
|
S MPDARR="^"_XX_"TMP(""PPP"","_$J_",""RESULTS"")"
|
|
S EXCARR="^"_XX_"TMP(""PPP"","_$J_",""EXCLUDE"")"
|
|
S KLLARRAY="^"_XX_"TMP(""PPP"")" S X=0 F S X=$O(@KLLARRAY@(X)) Q:X="" K @KLLARRAY@(X)
|
|
S X=0 F S X=$O(@MPDARR@(X)) Q:X="" K @MPDARR@(X)
|
|
S @EXCARR@(PPPSTANO)=""
|
|
;
|
|
1 ;
|
|
S MAXTM=1000,STARTTM=$$NOW^PPPCNV1 ;Max time = 10 minutes
|
|
F S PPPSSN=$O(@SORTSSN@(PPPSSN)) Q:PPPSSN="" S CNTR1=$G(CNTR1)+1,^TMP("PPP SORT",CNTR1)=PPPSSN,PPPEND=PPPSSN
|
|
K CNTR,CNTR2,SSNCNT,PATCHK,PATCHG,PATADD,SITECNT,DMNNEW
|
|
2 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
|
|
G 2
|
|
3 S X=0 F S X=$O(@MPDARR@(X)) Q:X="" K @MPDARR@(X)
|
|
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)
|
|
I +ERR<0 S ERRTXT=$G(ERRTXT)+1,^TMP($J,"PPPERR",ERRTXT)="Error : "_$P(ERR,"^",2) G FINI
|
|
4 I $D(@MPDARR@("DONE",PPPEND)) K PPPSSN G BGN
|
|
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
|
|
H .5 G 4
|
|
BGN ;begin compilation of data
|
|
S PPPSSN=$S('$D(PPPSSN):$O(@MPDARR@("DONE",0)),1:$O(@MPDARR@("DONE",PPPSSN))) G NXTBTCH:PPPSSN="" S SSNCNT=$G(SSNCNT)+1
|
|
S $P(^PPP(1020.1,1,2),"^",1)=PPPSSN
|
|
I '$D(@MPDARR@(PPPSSN,"FOUND")) G BGN
|
|
I @MPDARR@(PPPSSN,"FOUND")'>0 G BGN
|
|
S PATDFN=$O(@SORTSSN@(PPPSSN,0)) I $G(PATDFN)'>0 G BGN
|
|
S PPPSITE=0
|
|
FAC ;Get facilities visited
|
|
S PPPSITE=$O(@MPDARR@(PPPSSN,"SITES",PPPSITE)) G BGN:PPPSITE'>0 K PPPERR1 D
|
|
.;Get internal ien for station & domain name
|
|
.I $D(^PPP(1020.5,"B",PPPSITE)) S PPPERR1=1 Q
|
|
.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
|
|
.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
|
|
.I $D(^PPP(1020.8,PPPSITE)) S PPPIEN=PPPSITE Q
|
|
.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)
|
|
I $G(PPPERR1)=1 K PPPERR1 G FAC
|
|
S PPPIEN=$S($G(PPPIEN)'="":PPPIEN,1:PPPSITE)
|
|
S:$G(DMNNAME)="" DMNNAME=""
|
|
S LNUM=0 I $G(DMNNAME)]"" S LNUM=$O(^PPP(1020.128,"A",DMNNAME,0))
|
|
I LNUM S DMNNAME=$P(^PPP(1020.128,LNUM,0),"^",2),DMNNEW=$G(DMNNEW)+1
|
|
;
|
|
UPDATE ;new entry or update old
|
|
S X=@MPDARR@(PPPSSN,"SITES",PPPSITE),%DT="" D ^%DT S LSTVISIT=Y K X,UPDATE1
|
|
I $G(DMNNAME)'="",$D(^PPP(1020.2,"AC",PATDFN,DMNNAME)) S PPPIEN1=$O(^PPP(1020.2,"AC",PATDFN,DMNNAME,0)) D
|
|
.Q:$G(PPPIEN1)'>0
|
|
.S OLDDT=$P($G(^PPP(1020.2,PPPIEN1,0)),"^",3) ;Date of last visit
|
|
.I LSTVISIT>OLDDT S DIE="^PPP(1020.2,",DA=PPPIEN1,DR="2///"_LSTVISIT D ^DIE K DR,DIE
|
|
.S UPDATE1=1 Q
|
|
I $G(UPDATE1)=1 G FAC ;get next facility visited
|
|
NEWSSN ;
|
|
S X=PATDFN,DIC="^PPP(1020.2,",DIC(0)="",DIC("DR")="1////"_PPPIEN_";2///"_LSTVISIT_";7///0" K DD,D0 D FILE^DICN
|
|
G FAC
|
|
;
|
|
FINI ;Done
|
|
G ^PPPBFFX2
|
|
Q D Q^PPPBFFX K ^TMP($J) Q
|
|
S X=0 F S X=$O(@KLLARRAY@(X)) Q:X="" K @KLLARRAY@(X)
|
|
K X,KLLARRAY Q
|
|
TXT S ERRTXT=$G(ERRTXT)+1 Q
|
|
NXTBTCH S X=0 F S X=$O(@SSNARR@(X)) Q:X="" K @SSNARR@(X)
|
|
S X=0 F S X=$O(@MPDARR@(X)) Q:X="" K @MPDARR@(X),@MPDARR@("DONE",X)
|
|
S CNTR2=0
|
|
G 2
|