PSBPXFL.m

PSBPXFL ;BIR/RMS - BCMA TO PCE LINK FOR IMMUNIZATIONS ; 4/11/14 2:30pm

 ;;3.0;BAR CODE MED ADMIN;**47,76,142**;Mar 2004;Build 12

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

 ;

 ; Reference/IA

 ; $$DATA2PCE^PXAPI/1889

 ; $$PKG2IEN^VSIT/1904

 ; ^DIC(42/10039

 ; ^SC(/10040

 ;

BCMA2PCE(PSBDFN,PSBIMM,PSBDX,PSBDT,PSBWHO,PSBLOC) ;

 Q  ;p142 bcma2pce sunset

 D CLEAN

 D SETUP

 Q:$G(PSBSTOP)

 S PSBRSLT=$$DATA2PCE^PXAPI(PSBROOT,PSBPKG,PSBSRC)

 W:$E(IOST)="C" !,"Result code: ",PSBRSLT

 D CLEAN

 Q

SETUP S PSBROOT="^TMP(""PSBXAPI"",$J)"

 S PSBPKG=$$PKG2IEN^VSIT("PSB")

 S PSBSRC="EXTERNAL API"

ENC S @PSBROOT@("ENCOUNTER",1,"ENC D/T")=$G(PSBDT,DT)

 S @PSBROOT@("ENCOUNTER",1,"PATIENT")=PSBDFN

 S @PSBROOT@("ENCOUNTER",1,"HOS LOC")=$$LOC Q:$G(PSBSTOP)

 S @PSBROOT@("ENCOUNTER",1,"SERVICE CATEGORY")="E"

 S @PSBROOT@("ENCOUNTER",1,"INSTITUTION")=+$$SITE^VASITE

 S @PSBROOT@("ENCOUNTER",1,"ENCOUNTER TYPE")="P"

 S @PSBROOT@("ENCOUNTER",1,"SC")=$$SC

PROV S @PSBROOT@("PROVIDER",1,"NAME")=PSBWHO

IMMUN S @PSBROOT@("IMMUNIZATION",1,"COMMENT")="@"

 S @PSBROOT@("IMMUNIZATION",1,"CONTRAINDICATED")=0

 S @PSBROOT@("IMMUNIZATION",1,"IMMUN")=PSBIMM

 S @PSBROOT@("IMMUNIZATION",1,"REACTION")="@"

 S @PSBROOT@("IMMUNIZATION",1,"SERIES")="@"

SC() ;SERVICE CONNECTED

 N VAEL

 S DFN=PSBDFN

 D ELIG^VADPT

 Q $S(+VAEL(3)=1:0,1:"")

LOC() ;HOSPITAL LOCATION, modified in PSB*3*76 to include clinic locations

 S PSBLIEN="" F  S PSBLIEN=$O(^SC("B",PSBLOC,PSBLIEN)) Q:'PSBLIEN  Q:$P(^SC(PSBLIEN,0),U,3)="C"

 I PSBLIEN>0 Q PSBLIEN  ;-> Found a clinic location as exact match

 N DFN,VAIP

 S DFN=PSBDFN

 S VAIP("D")=$G(PSBDT,DT)

 D IN5^VADPT

 I +VAIP(5) S PSBLIEN=$G(^DIC(42,+VAIP(5),44))

 I PSBLIEN>0 Q PSBLIEN  ;-> Found a ward location at BCMA MedLog D/T

 S VAIP("D")="L"

 D IN5^VADPT

 I +VAIP(5) S PSBLIEN=$G(^DIC(42,+VAIP(5),44))

 I PSBLIEN>0 Q PSBLIEN  ;-> Use last inpatient location

 S PSBSTOP=1

 Q ""  ;-> No location found, stop flag set, do not file entry

CLEAN K ^TMP("PSBPXAPI",$J)

 K PSBSTOP,PSBROOT,PSBPKG,PSBSRC,PSBRSLT

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---PSBPXFL   2123     printed  Apr 09, 2024@20:44:19                                                                                                                                                                                                     Page 2

PSBPXFL   ;BIR/RMS - BCMA TO PCE LINK FOR IMMUNIZATIONS ; 4/11/14 2:30pm

 +1       ;;3.0;BAR CODE MED ADMIN;**47,76,142**;Mar 2004;Build 12

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

 +3       ;

 +4       ; Reference/IA

 +5       ; $$DATA2PCE^PXAPI/1889

 +6       ; $$PKG2IEN^VSIT/1904

 +7       ; ^DIC(42/10039

 +8       ; ^SC(/10040

 +9       ;

BCMA2PCE(PSBDFN,PSBIMM,PSBDX,PSBDT,PSBWHO,PSBLOC) ;

 +1       ;p142 bcma2pce sunset

           QUIT 

 +2        DO CLEAN

 +3        DO SETUP

 +4        if $GET(PSBSTOP)

               QUIT 

 +5        SET PSBRSLT=$$DATA2PCE^PXAPI(PSBROOT,PSBPKG,PSBSRC)

 +6        if $EXTRACT(IOST)="C"

               WRITE !,"Result code: ",PSBRSLT

 +7        DO CLEAN

 +8        QUIT 

SETUP      SET PSBROOT="^TMP(""PSBXAPI"",$J)"

 +1        SET PSBPKG=$$PKG2IEN^VSIT("PSB")

 +2        SET PSBSRC="EXTERNAL API"

ENC        SET @PSBROOT@("ENCOUNTER",1,"ENC D/T")=$GET(PSBDT,DT)

 +1        SET @PSBROOT@("ENCOUNTER",1,"PATIENT")=PSBDFN

 +2        SET @PSBROOT@("ENCOUNTER",1,"HOS LOC")=$$LOC

           if $GET(PSBSTOP)

               QUIT 

 +3        SET @PSBROOT@("ENCOUNTER",1,"SERVICE CATEGORY")="E"

 +4        SET @PSBROOT@("ENCOUNTER",1,"INSTITUTION")=+$$SITE^VASITE

 +5        SET @PSBROOT@("ENCOUNTER",1,"ENCOUNTER TYPE")="P"

 +6        SET @PSBROOT@("ENCOUNTER",1,"SC")=$$SC

PROV       SET @PSBROOT@("PROVIDER",1,"NAME")=PSBWHO

IMMUN      SET @PSBROOT@("IMMUNIZATION",1,"COMMENT")="@"

 +1        SET @PSBROOT@("IMMUNIZATION",1,"CONTRAINDICATED")=0

 +2        SET @PSBROOT@("IMMUNIZATION",1,"IMMUN")=PSBIMM

 +3        SET @PSBROOT@("IMMUNIZATION",1,"REACTION")="@"

 +4        SET @PSBROOT@("IMMUNIZATION",1,"SERIES")="@"

SC()      ;SERVICE CONNECTED

 +1        NEW VAEL

 +2        SET DFN=PSBDFN

 +3        DO ELIG^VADPT

 +4        QUIT $SELECT(+VAEL(3)=1:0,1:"")

LOC()     ;HOSPITAL LOCATION, modified in PSB*3*76 to include clinic locations

 +1        SET PSBLIEN=""

           FOR 

               SET PSBLIEN=$ORDER(^SC("B",PSBLOC,PSBLIEN))

               if 'PSBLIEN

                   QUIT 

               if $PIECE(^SC(PSBLIEN,0),U,3)="C"

                   QUIT 

 +2       ;-> Found a clinic location as exact match

           IF PSBLIEN>0

               QUIT PSBLIEN

 +3        NEW DFN,VAIP

 +4        SET DFN=PSBDFN

 +5        SET VAIP("D")=$GET(PSBDT,DT)

 +6        DO IN5^VADPT

 +7        IF +VAIP(5)

               SET PSBLIEN=$GET(^DIC(42,+VAIP(5),44))

 +8       ;-> Found a ward location at BCMA MedLog D/T

           IF PSBLIEN>0

               QUIT PSBLIEN

 +9        SET VAIP("D")="L"

 +10       DO IN5^VADPT

 +11       IF +VAIP(5)

               SET PSBLIEN=$GET(^DIC(42,+VAIP(5),44))

 +12      ;-> Use last inpatient location

           IF PSBLIEN>0

               QUIT PSBLIEN

 +13       SET PSBSTOP=1

 +14      ;-> No location found, stop flag set, do not file entry

           QUIT ""

CLEAN      KILL ^TMP("PSBPXAPI",$JOB)

 +1        KILL PSBSTOP,PSBROOT,PSBPKG,PSBSRC,PSBRSLT

 +2        QUIT