| 1 | PPPBFFX1 ;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
|
|---|
| 4 | PPPSTRT ;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 | ;
|
|---|
| 25 | 1 ;
|
|---|
| 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
|
|---|
| 29 | 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
|
|---|
| 30 | G 2
|
|---|
| 31 | 3 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
|
|---|
| 34 | 4 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
|
|---|
| 37 | BGN ;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
|
|---|
| 44 | FAC ;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 | ;
|
|---|
| 58 | UPDATE ;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
|
|---|
| 66 | NEWSSN ;
|
|---|
| 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 | ;
|
|---|
| 70 | FINI ;Done
|
|---|
| 71 | G ^PPPBFFX2
|
|---|
| 72 | Q 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
|
|---|
| 75 | TXT S ERRTXT=$G(ERRTXT)+1 Q
|
|---|
| 76 | NXTBTCH 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
|
|---|
