source: FOIAVistA/tag/r/OUTPATIENT_PHARMACY-PSO-APSP-HUIP/PSO254PI.m@ 628

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

initial load of FOIAVistA 6/30/08 version
File size: 4.8 KB
Line 
1PSO254PI ;BHAM-ISC/MFR - POPULATE NPI INSTITUTION IN FILE 59 ;07/26/06
2 ;;7.0;OUTPATIENT PHARMACY;**254**;DEC 1997;Build 19
3 ;Reference to $$QI^XUSNPI.$$NPI^XUSNPI supported by IA 4532
4 ;Reference to ^XUSEC( supported by IA 10076
5 ;Reference to ^XPDUTL supported by IA 10141
6 ;Reference to INSTITUTION file (#4) supported by IA 10090
7 ;
8 N SITE,DIVNAM,TMP,PSODIV,INACT,DIE,DA,DR,DIVCNT,NAMSITE,PSOINST,NPINST,PSONCPDP,PSONPI,PSOPOP,SUB,X,PSODUZ,LIST,I
9 D SETTMP,SETTMP^PSO254P1
10 S (PSODIV,DIVCNT)=0 F S PSODIV=$O(^PS(59,PSODIV)) Q:'PSODIV D
11 . S INACT=$$GET1^DIQ(59,PSODIV,2004,"I") I INACT,DT>INACT Q
12 . S DIVNAM=$$GET1^DIQ(59,PSODIV,.01,"I") I DIVNAM="" S DIVNAM="DIVISION IEN #"_PSODIV
13 . S SITE=$$GET1^DIQ(59,PSODIV,.06,"I"),PSONCPDP=$$GET1^DIQ(59,PSODIV,1008,"I")
14 . S DIVCNT=DIVCNT+1,SUB=$E(DIVNAM,1,20)_"("_SITE_")",NPINST=$$GET1^DIQ(59,PSODIV,101,"I")
15 . I NPINST D Q
16 . . S PSOPOP(SUB)="INSTITUTION ALREADY SET("_$E($$GET1^DIQ(4,NPINST,.01),1,15)_")^"_$P($$NPI^XUSNPI("Organization_ID",NPINST,DT),"^")
17 . I PSONCPDP="",SITE="" S PSOPOP(SUB)="NO SITE# OR NCPDP# FOUND FOR DIVISION" Q
18 . I PSONCPDP,'$D(TMP(PSONCPDP)) S PSOPOP(SUB)="NO DIVISION FOUND FOR NCPDP#"_PSONCPDP Q
19 . S PSONPI=0 S:PSONCPDP'="" PSONPI=$P(TMP(PSONCPDP),"^",3)
20 . I 'PSONPI S PSOPOP(SUB)="NO NPI# FOUND FOR THIS DIVISION" Q
21 . S LIST=$$QI^XUSNPI(PSONPI),PSOINST=0
22 . F I=1:1:$L(LIST,";") D I PSOINST Q
23 . . I $P(LIST,";",I)="" Q
24 . . I $P($P(LIST,";",I),"^",4)'="Active" Q
25 . . I '$P($P(LIST,";",I),"^",2) Q
26 . . S PSOINST=+$P($P(LIST,";",I),"^",2)
27 . I 'PSOINST S PSOPOP(SUB)="NO INSTITUTION FOUND FOR NPI #"_PSONPI_"^"_PSONPI Q
28 . S DIE="^PS(59,",DA=PSODIV,DR="101////"_PSOINST D ^DIE K DIE,DA,DR
29 . S PSOPOP(SUB)=$$GET1^DIQ(4,PSOINST,.01)_"^"_PSONPI
30 ;
31 D MAIL
32 Q
33 ;
34MAIL ; Compose/Send the Mailman message
35 N XMDUZ,XMSUB,XMY,XMTEXT,LINE,PSOTEXT,I
36 S XMDUZ="Patch PSO*7*254",XMSUB="NPI INSTITUTION POPULATION"
37 F I=0:1 S PSODUZ=$G(@XPDGREF@("PSO254USR"_I)) Q:'PSODUZ S XMY(PSODUZ)=""
38 S PSOTEXT(1)="PSO*7*254 POST-INSTALL - POPULATES NPI INSTITUTION FIELD (#101)"
39 S PSOTEXT(2)=" IN THE OUTPATIENT SITE FILE (#59)"
40 S PSOTEXT(3)=" "
41 S PSOTEXT(4)="Please, validate that the NPI INSTITUTION assignment below is correct for "
42 S PSOTEXT(5)="each active DIVISION. If not, please use the Site Parameter Enter/Edit [PSO"
43 S PSOTEXT(6)="SITE PARAMETERS] option and assign the correct NPI INSTITUTION."
44 S PSOTEXT(7)=" "
45 S $P(PSOTEXT(8),"-",80)=""
46 S X="DIVISION(SITE#)",$E(X,28)="NPI#",$E(X,40)="NPI INSTITUTION"
47 S PSOTEXT(9)=X
48 S $P(PSOTEXT(10),"-",80)=""
49 S LINE=10
50 S (NAMSITE)=""
51 F S NAMSITE=$O(PSOPOP(NAMSITE)) Q:NAMSITE="" D
52 . S LINE=LINE+1,X=NAMSITE
53 . S $E(X,28)=$J($P(PSOPOP(NAMSITE),"^",2),10)
54 . S $E(X,40)=$P(PSOPOP(NAMSITE),"^")
55 . S PSOTEXT(LINE)=X
56 S PSOTEXT(LINE+1)=" ",PSOTEXT(LINE+2)="TOTAL: "_DIVCNT_" Division(s)."
57 S XMTEXT="PSOTEXT(" N DIFROM D ^XMD
58 Q
59 ;
60SETTMP ; TMP(NCPDP#)="SITE NAME^SITE NUMBER^NPI NUMBER"
61 K TMP
62 S TMP(3338349)="Albany VAMC^528A8^1801854880"
63 S TMP(3208899)="Albuquerque VAMC^501^1396703336"
64 S TMP(1914717)="Alexandria VAMC^502^1922066968"
65 S TMP(3982293)="Allentown OPC^693B4^1821056862"
66 S TMP(3973004)="Altoona VAMC^503^1558329599"
67 S TMP(4525690)="Amarillo VAMC^504^1235197658"
68 S TMP(225842)="Anchorage VAOPC^463^1871551820"
69 S TMP(2358162)="Ann Arbor VAMC^506^1821055906"
70 S TMP(3412222)="Asheville VAMC^637^1417914508"
71 S TMP(3981936)="Aspinwall VAMC^646A4^1861440885"
72 S TMP(1119672)="Atlanta VAMC^508^1295793248"
73 S TMP(1147912)="Augusta VAMC (Downtown)^509AO^1649237751"
74 S TMP(1152925)="Augusta VAMC (Uptown)^509^1194783142"
75 S TMP(4529117)="Austin VAMC^674Z^1538126651"
76 S TMP(566820)="Bakersfield CBOC^^1427006634"
77 S TMP(2122036)="Baltimore VAMC^512^1164480596"
78 S TMP(3346017)="Batavia VAMC^528A4^1306803424"
79 S TMP(3350458)="Bath VAMC^528A6^1952368078"
80 S TMP(1917698)="Baton Rouge Outpatient Clinic^629^1679530794"
81 S TMP(2354621)="Battle Creek VAMC^515^1700843836"
82 S TMP(1098981)="Bay Pines VAMC^516^1376591396"
83 S TMP(5005497)="Beckley VAMC^517^1104884535"
84 S TMP(2233548)="Bedford VAMC^518^1154388288"
85 S TMP(4594190)="Big Spring VAMC^519^1407813538"
86 S TMP(2764555)="Billings CBOC^436GH^1568410595"
87 S TMP(2517350)="Biloxi VAMC^520^1396703427"
88 S TMP(3333476)="Binghamton Outpatient Clinic^528GN^1831157965"
89 S TMP(131829)="Birmingham VAMC^521^1508824632"
90 S TMP(1305766)="Boise VAMC^531^1841258985"
91 S TMP(4539447)="Bonham VAMC^549A4^1992763031"
92 S TMP(2235100)="Boston VAMC^523^1326006461"
93 S TMP(2240202)="Boston-Causeway CBOC^523BZ^1215995410"
94 S TMP(2240214)="Brockton VAMC^523A5^1447218896"
95 S TMP(3336725)="Bronx VAMC^526^1821056995"
96 S TMP(3330773)="Brooklyn VAMC^630A4^1275591232"
97 S TMP(3964295)="Butler VAMC^529^1649238759"
98 S TMP(3334163)="Canandaigua VAMC^528A5^1164480273"
99 S TMP(353083)="Carl T. Hayden VA Med Clinic Northwest Extension^644^1871551986"
100 S TMP(353069)="Carl T. Hayden VA Med Clinic Southeast Extension^644^1477511590"
101 Q
Note: See TracBrowser for help on using the repository browser.