PSO254PI ;BHAM-ISC/MFR - POPULATE NPI INSTITUTION IN FILE 59 ;07/26/06
;;7.0;OUTPATIENT PHARMACY;**254**;DEC 1997;Build 19
;Reference to $$QI^XUSNPI.$$NPI^XUSNPI supported by IA 4532
;Reference to ^XUSEC( supported by IA 10076
;Reference to ^XPDUTL supported by IA 10141
;Reference to INSTITUTION file (#4) supported by IA 10090
;
N SITE,DIVNAM,TMP,PSODIV,INACT,DIE,DA,DR,DIVCNT,NAMSITE,PSOINST,NPINST,PSONCPDP,PSONPI,PSOPOP,SUB,X,PSODUZ,LIST,I
D SETTMP,SETTMP^PSO254P1
S (PSODIV,DIVCNT)=0 F S PSODIV=$O(^PS(59,PSODIV)) Q:'PSODIV D
. S INACT=$$GET1^DIQ(59,PSODIV,2004,"I") I INACT,DT>INACT Q
. S DIVNAM=$$GET1^DIQ(59,PSODIV,.01,"I") I DIVNAM="" S DIVNAM="DIVISION IEN #"_PSODIV
. S SITE=$$GET1^DIQ(59,PSODIV,.06,"I"),PSONCPDP=$$GET1^DIQ(59,PSODIV,1008,"I")
. S DIVCNT=DIVCNT+1,SUB=$E(DIVNAM,1,20)_"("_SITE_")",NPINST=$$GET1^DIQ(59,PSODIV,101,"I")
. I NPINST D Q
. . S PSOPOP(SUB)="INSTITUTION ALREADY SET("_$E($$GET1^DIQ(4,NPINST,.01),1,15)_")^"_$P($$NPI^XUSNPI("Organization_ID",NPINST,DT),"^")
. I PSONCPDP="",SITE="" S PSOPOP(SUB)="NO SITE# OR NCPDP# FOUND FOR DIVISION" Q
. I PSONCPDP,'$D(TMP(PSONCPDP)) S PSOPOP(SUB)="NO DIVISION FOUND FOR NCPDP#"_PSONCPDP Q
. S PSONPI=0 S:PSONCPDP'="" PSONPI=$P(TMP(PSONCPDP),"^",3)
. I 'PSONPI S PSOPOP(SUB)="NO NPI# FOUND FOR THIS DIVISION" Q
. S LIST=$$QI^XUSNPI(PSONPI),PSOINST=0
. F I=1:1:$L(LIST,";") D I PSOINST Q
. . I $P(LIST,";",I)="" Q
. . I $P($P(LIST,";",I),"^",4)'="Active" Q
. . I '$P($P(LIST,";",I),"^",2) Q
. . S PSOINST=+$P($P(LIST,";",I),"^",2)
. I 'PSOINST S PSOPOP(SUB)="NO INSTITUTION FOUND FOR NPI #"_PSONPI_"^"_PSONPI Q
. S DIE="^PS(59,",DA=PSODIV,DR="101////"_PSOINST D ^DIE K DIE,DA,DR
. S PSOPOP(SUB)=$$GET1^DIQ(4,PSOINST,.01)_"^"_PSONPI
;
D MAIL
Q
;
MAIL ; Compose/Send the Mailman message
N XMDUZ,XMSUB,XMY,XMTEXT,LINE,PSOTEXT,I
S XMDUZ="Patch PSO*7*254",XMSUB="NPI INSTITUTION POPULATION"
F I=0:1 S PSODUZ=$G(@XPDGREF@("PSO254USR"_I)) Q:'PSODUZ S XMY(PSODUZ)=""
S PSOTEXT(1)="PSO*7*254 POST-INSTALL - POPULATES NPI INSTITUTION FIELD (#101)"
S PSOTEXT(2)=" IN THE OUTPATIENT SITE FILE (#59)"
S PSOTEXT(3)=" "
S PSOTEXT(4)="Please, validate that the NPI INSTITUTION assignment below is correct for "
S PSOTEXT(5)="each active DIVISION. If not, please use the Site Parameter Enter/Edit [PSO"
S PSOTEXT(6)="SITE PARAMETERS] option and assign the correct NPI INSTITUTION."
S PSOTEXT(7)=" "
S $P(PSOTEXT(8),"-",80)=""
S X="DIVISION(SITE#)",$E(X,28)="NPI#",$E(X,40)="NPI INSTITUTION"
S PSOTEXT(9)=X
S $P(PSOTEXT(10),"-",80)=""
S LINE=10
S (NAMSITE)=""
F S NAMSITE=$O(PSOPOP(NAMSITE)) Q:NAMSITE="" D
. S LINE=LINE+1,X=NAMSITE
. S $E(X,28)=$J($P(PSOPOP(NAMSITE),"^",2),10)
. S $E(X,40)=$P(PSOPOP(NAMSITE),"^")
. S PSOTEXT(LINE)=X
S PSOTEXT(LINE+1)=" ",PSOTEXT(LINE+2)="TOTAL: "_DIVCNT_" Division(s)."
S XMTEXT="PSOTEXT(" N DIFROM D ^XMD
Q
;
SETTMP ; TMP(NCPDP#)="SITE NAME^SITE NUMBER^NPI NUMBER"
K TMP
S TMP(3338349)="Albany VAMC^528A8^1801854880"
S TMP(3208899)="Albuquerque VAMC^501^1396703336"
S TMP(1914717)="Alexandria VAMC^502^1922066968"
S TMP(3982293)="Allentown OPC^693B4^1821056862"
S TMP(3973004)="Altoona VAMC^503^1558329599"
S TMP(4525690)="Amarillo VAMC^504^1235197658"
S TMP(225842)="Anchorage VAOPC^463^1871551820"
S TMP(2358162)="Ann Arbor VAMC^506^1821055906"
S TMP(3412222)="Asheville VAMC^637^1417914508"
S TMP(3981936)="Aspinwall VAMC^646A4^1861440885"
S TMP(1119672)="Atlanta VAMC^508^1295793248"
S TMP(1147912)="Augusta VAMC (Downtown)^509AO^1649237751"
S TMP(1152925)="Augusta VAMC (Uptown)^509^1194783142"
S TMP(4529117)="Austin VAMC^674Z^1538126651"
S TMP(566820)="Bakersfield CBOC^^1427006634"
S TMP(2122036)="Baltimore VAMC^512^1164480596"
S TMP(3346017)="Batavia VAMC^528A4^1306803424"
S TMP(3350458)="Bath VAMC^528A6^1952368078"
S TMP(1917698)="Baton Rouge Outpatient Clinic^629^1679530794"
S TMP(2354621)="Battle Creek VAMC^515^1700843836"
S TMP(1098981)="Bay Pines VAMC^516^1376591396"
S TMP(5005497)="Beckley VAMC^517^1104884535"
S TMP(2233548)="Bedford VAMC^518^1154388288"
S TMP(4594190)="Big Spring VAMC^519^1407813538"
S TMP(2764555)="Billings CBOC^436GH^1568410595"
S TMP(2517350)="Biloxi VAMC^520^1396703427"
S TMP(3333476)="Binghamton Outpatient Clinic^528GN^1831157965"
S TMP(131829)="Birmingham VAMC^521^1508824632"
S TMP(1305766)="Boise VAMC^531^1841258985"
S TMP(4539447)="Bonham VAMC^549A4^1992763031"
S TMP(2235100)="Boston VAMC^523^1326006461"
S TMP(2240202)="Boston-Causeway CBOC^523BZ^1215995410"
S TMP(2240214)="Brockton VAMC^523A5^1447218896"
S TMP(3336725)="Bronx VAMC^526^1821056995"
S TMP(3330773)="Brooklyn VAMC^630A4^1275591232"
S TMP(3964295)="Butler VAMC^529^1649238759"
S TMP(3334163)="Canandaigua VAMC^528A5^1164480273"
S TMP(353083)="Carl T. Hayden VA Med Clinic Northwest Extension^644^1871551986"
S TMP(353069)="Carl T. Hayden VA Med Clinic Southeast Extension^644^1477511590"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSO254PI 5037 printed Sep 23, 2025@19:58:54 Page 2
PSO254PI ;BHAM-ISC/MFR - POPULATE NPI INSTITUTION IN FILE 59 ;07/26/06
+1 ;;7.0;OUTPATIENT PHARMACY;**254**;DEC 1997;Build 19
+2 ;Reference to $$QI^XUSNPI.$$NPI^XUSNPI supported by IA 4532
+3 ;Reference to ^XUSEC( supported by IA 10076
+4 ;Reference to ^XPDUTL supported by IA 10141
+5 ;Reference to INSTITUTION file (#4) supported by IA 10090
+6 ;
+7 NEW SITE,DIVNAM,TMP,PSODIV,INACT,DIE,DA,DR,DIVCNT,NAMSITE,PSOINST,NPINST,PSONCPDP,PSONPI,PSOPOP,SUB,X,PSODUZ,LIST,I
+8 DO SETTMP
DO SETTMP^PSO254P1
+9 SET (PSODIV,DIVCNT)=0
FOR
SET PSODIV=$ORDER(^PS(59,PSODIV))
if 'PSODIV
QUIT
Begin DoDot:1
+10 SET INACT=$$GET1^DIQ(59,PSODIV,2004,"I")
IF INACT
IF DT>INACT
QUIT
+11 SET DIVNAM=$$GET1^DIQ(59,PSODIV,.01,"I")
IF DIVNAM=""
SET DIVNAM="DIVISION IEN #"_PSODIV
+12 SET SITE=$$GET1^DIQ(59,PSODIV,.06,"I")
SET PSONCPDP=$$GET1^DIQ(59,PSODIV,1008,"I")
+13 SET DIVCNT=DIVCNT+1
SET SUB=$EXTRACT(DIVNAM,1,20)_"("_SITE_")"
SET NPINST=$$GET1^DIQ(59,PSODIV,101,"I")
+14 IF NPINST
Begin DoDot:2
+15 SET PSOPOP(SUB)="INSTITUTION ALREADY SET("_$EXTRACT($$GET1^DIQ(4,NPINST,.01),1,15)_")^"_$PIECE($$NPI^XUSNPI("Organization_ID",NPINST,DT),"^")
End DoDot:2
QUIT
+16 IF PSONCPDP=""
IF SITE=""
SET PSOPOP(SUB)="NO SITE# OR NCPDP# FOUND FOR DIVISION"
QUIT
+17 IF PSONCPDP
IF '$DATA(TMP(PSONCPDP))
SET PSOPOP(SUB)="NO DIVISION FOUND FOR NCPDP#"_PSONCPDP
QUIT
+18 SET PSONPI=0
if PSONCPDP'=""
SET PSONPI=$PIECE(TMP(PSONCPDP),"^",3)
+19 IF 'PSONPI
SET PSOPOP(SUB)="NO NPI# FOUND FOR THIS DIVISION"
QUIT
+20 SET LIST=$$QI^XUSNPI(PSONPI)
SET PSOINST=0
+21 FOR I=1:1:$LENGTH(LIST,";")
Begin DoDot:2
+22 IF $PIECE(LIST,";",I)=""
QUIT
+23 IF $PIECE($PIECE(LIST,";",I),"^",4)'="Active"
QUIT
+24 IF '$PIECE($PIECE(LIST,";",I),"^",2)
QUIT
+25 SET PSOINST=+$PIECE($PIECE(LIST,";",I),"^",2)
End DoDot:2
IF PSOINST
QUIT
+26 IF 'PSOINST
SET PSOPOP(SUB)="NO INSTITUTION FOUND FOR NPI #"_PSONPI_"^"_PSONPI
QUIT
+27 SET DIE="^PS(59,"
SET DA=PSODIV
SET DR="101////"_PSOINST
DO ^DIE
KILL DIE,DA,DR
+28 SET PSOPOP(SUB)=$$GET1^DIQ(4,PSOINST,.01)_"^"_PSONPI
End DoDot:1
+29 ;
+30 DO MAIL
+31 QUIT
+32 ;
MAIL ; Compose/Send the Mailman message
+1 NEW XMDUZ,XMSUB,XMY,XMTEXT,LINE,PSOTEXT,I
+2 SET XMDUZ="Patch PSO*7*254"
SET XMSUB="NPI INSTITUTION POPULATION"
+3 FOR I=0:1
SET PSODUZ=$GET(@XPDGREF@("PSO254USR"_I))
if 'PSODUZ
QUIT
SET XMY(PSODUZ)=""
+4 SET PSOTEXT(1)="PSO*7*254 POST-INSTALL - POPULATES NPI INSTITUTION FIELD (#101)"
+5 SET PSOTEXT(2)=" IN THE OUTPATIENT SITE FILE (#59)"
+6 SET PSOTEXT(3)=" "
+7 SET PSOTEXT(4)="Please, validate that the NPI INSTITUTION assignment below is correct for "
+8 SET PSOTEXT(5)="each active DIVISION. If not, please use the Site Parameter Enter/Edit [PSO"
+9 SET PSOTEXT(6)="SITE PARAMETERS] option and assign the correct NPI INSTITUTION."
+10 SET PSOTEXT(7)=" "
+11 SET $PIECE(PSOTEXT(8),"-",80)=""
+12 SET X="DIVISION(SITE#)"
SET $EXTRACT(X,28)="NPI#"
SET $EXTRACT(X,40)="NPI INSTITUTION"
+13 SET PSOTEXT(9)=X
+14 SET $PIECE(PSOTEXT(10),"-",80)=""
+15 SET LINE=10
+16 SET (NAMSITE)=""
+17 FOR
SET NAMSITE=$ORDER(PSOPOP(NAMSITE))
if NAMSITE=""
QUIT
Begin DoDot:1
+18 SET LINE=LINE+1
SET X=NAMSITE
+19 SET $EXTRACT(X,28)=$JUSTIFY($PIECE(PSOPOP(NAMSITE),"^",2),10)
+20 SET $EXTRACT(X,40)=$PIECE(PSOPOP(NAMSITE),"^")
+21 SET PSOTEXT(LINE)=X
End DoDot:1
+22 SET PSOTEXT(LINE+1)=" "
SET PSOTEXT(LINE+2)="TOTAL: "_DIVCNT_" Division(s)."
+23 SET XMTEXT="PSOTEXT("
NEW DIFROM
DO ^XMD
+24 QUIT
+25 ;
SETTMP ; TMP(NCPDP#)="SITE NAME^SITE NUMBER^NPI NUMBER"
+1 KILL TMP
+2 SET TMP(3338349)="Albany VAMC^528A8^1801854880"
+3 SET TMP(3208899)="Albuquerque VAMC^501^1396703336"
+4 SET TMP(1914717)="Alexandria VAMC^502^1922066968"
+5 SET TMP(3982293)="Allentown OPC^693B4^1821056862"
+6 SET TMP(3973004)="Altoona VAMC^503^1558329599"
+7 SET TMP(4525690)="Amarillo VAMC^504^1235197658"
+8 SET TMP(225842)="Anchorage VAOPC^463^1871551820"
+9 SET TMP(2358162)="Ann Arbor VAMC^506^1821055906"
+10 SET TMP(3412222)="Asheville VAMC^637^1417914508"
+11 SET TMP(3981936)="Aspinwall VAMC^646A4^1861440885"
+12 SET TMP(1119672)="Atlanta VAMC^508^1295793248"
+13 SET TMP(1147912)="Augusta VAMC (Downtown)^509AO^1649237751"
+14 SET TMP(1152925)="Augusta VAMC (Uptown)^509^1194783142"
+15 SET TMP(4529117)="Austin VAMC^674Z^1538126651"
+16 SET TMP(566820)="Bakersfield CBOC^^1427006634"
+17 SET TMP(2122036)="Baltimore VAMC^512^1164480596"
+18 SET TMP(3346017)="Batavia VAMC^528A4^1306803424"
+19 SET TMP(3350458)="Bath VAMC^528A6^1952368078"
+20 SET TMP(1917698)="Baton Rouge Outpatient Clinic^629^1679530794"
+21 SET TMP(2354621)="Battle Creek VAMC^515^1700843836"
+22 SET TMP(1098981)="Bay Pines VAMC^516^1376591396"
+23 SET TMP(5005497)="Beckley VAMC^517^1104884535"
+24 SET TMP(2233548)="Bedford VAMC^518^1154388288"
+25 SET TMP(4594190)="Big Spring VAMC^519^1407813538"
+26 SET TMP(2764555)="Billings CBOC^436GH^1568410595"
+27 SET TMP(2517350)="Biloxi VAMC^520^1396703427"
+28 SET TMP(3333476)="Binghamton Outpatient Clinic^528GN^1831157965"
+29 SET TMP(131829)="Birmingham VAMC^521^1508824632"
+30 SET TMP(1305766)="Boise VAMC^531^1841258985"
+31 SET TMP(4539447)="Bonham VAMC^549A4^1992763031"
+32 SET TMP(2235100)="Boston VAMC^523^1326006461"
+33 SET TMP(2240202)="Boston-Causeway CBOC^523BZ^1215995410"
+34 SET TMP(2240214)="Brockton VAMC^523A5^1447218896"
+35 SET TMP(3336725)="Bronx VAMC^526^1821056995"
+36 SET TMP(3330773)="Brooklyn VAMC^630A4^1275591232"
+37 SET TMP(3964295)="Butler VAMC^529^1649238759"
+38 SET TMP(3334163)="Canandaigua VAMC^528A5^1164480273"
+39 SET TMP(353083)="Carl T. Hayden VA Med Clinic Northwest Extension^644^1871551986"
+40 SET TMP(353069)="Carl T. Hayden VA Med Clinic Southeast Extension^644^1477511590"
+41 QUIT
