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 ---[H[J[2J[HPSBPXFL 2123 printed Oct 16, 2024@17:41:56 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
