PSB3P83.m

PSB3P83 ;BIRMINGHAM/GN-Post install to save Inj to new Body list ;03/06/16 3:06pm

 ;;3.0;BAR CODE MED ADMIN;**83**;Mar 2004;Build 89

 ;Per VHA Directive 2004-038 (or future revisions regarding same), this routine should not be modified.

 ;

 ; Reference/IA

 ; $$GET^XPAR/2263

 ;

EN ;Copy a Divisions old PSB LIST INJECTION SITES to new BODY SITES

 ;

 N PARAM,ENT,QQ,SITE

 S PARAM=$O(^XTV(8989.51,"B","PSB ONLINE",""))   ;Online param ien

 ;

 ;Loop thru Kernel parameters for any Division with the parameter

 ; PSB ONLINE answered Y or N.  Nulls won't have an entry in "AC" xref

 S ENT=""

 F  S ENT=$O(^XTV(8989.5,"AC",PARAM,ENT)) Q:ENT=""  D

 .;

 .;loop thru all sites per Div per Old Inj list if it exists

 .F QQ=1:1 S SITE=$$GET^XPAR(ENT,"PSB LIST INJECTION SITES",QQ) Q:SITE=""  D

 ..;add sites to new list with new structure SiteText|flag|flag

 ..D EN^XPAR(ENT,"PSB LIST BODY SITES",QQ,SITE_"|1|0")

 .;

 .;remove all sites from old Inj list this ENT (Division)

 .D NDEL^XPAR(ENT,"PSB LIST INJECTION SITES")

 ;

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---PSB3P83   1042     printed  Feb 18, 2025@23:06:16                                                                                                                                                                                                     Page 2

PSB3P83   ;BIRMINGHAM/GN-Post install to save Inj to new Body list ;03/06/16 3:06pm

 +1       ;;3.0;BAR CODE MED ADMIN;**83**;Mar 2004;Build 89

 +2       ;Per VHA Directive 2004-038 (or future revisions regarding same), this routine should not be modified.

 +3       ;

 +4       ; Reference/IA

 +5       ; $$GET^XPAR/2263

 +6       ;

EN        ;Copy a Divisions old PSB LIST INJECTION SITES to new BODY SITES

 +1       ;

 +2        NEW PARAM,ENT,QQ,SITE

 +3       ;Online param ien

           SET PARAM=$ORDER(^XTV(8989.51,"B","PSB ONLINE",""))

 +4       ;

 +5       ;Loop thru Kernel parameters for any Division with the parameter

 +6       ; PSB ONLINE answered Y or N.  Nulls won't have an entry in "AC" xref

 +7        SET ENT=""

 +8        FOR 

               SET ENT=$ORDER(^XTV(8989.5,"AC",PARAM,ENT))

               if ENT=""

                   QUIT 

               Begin DoDot:1

 +9       ;

 +10      ;loop thru all sites per Div per Old Inj list if it exists

 +11               FOR QQ=1:1

                       SET SITE=$$GET^XPAR(ENT,"PSB LIST INJECTION SITES",QQ)

                       if SITE=""

                           QUIT 

                       Begin DoDot:2

 +12      ;add sites to new list with new structure SiteText|flag|flag

 +13                       DO EN^XPAR(ENT,"PSB LIST BODY SITES",QQ,SITE_"|1|0")

                       End DoDot:2

 +14      ;

 +15      ;remove all sites from old Inj list this ENT (Division)

 +16               DO NDEL^XPAR(ENT,"PSB LIST INJECTION SITES")

               End DoDot:1

 +17      ;

 +18       QUIT