PXVWVMR ;ISP/LMT - Build VMR Message for input to ICE ;12/13/17 12:23
;;1.0;PCE PATIENT CARE ENCOUNTER;**217**;Aug 12, 1996;Build 134
;
;
; Reference to ^PXD(811.9,"B", supported by ICR #3148 ; TODO - subscribe to ICR
; Reference to MAINDF^PXRM supported by ICR #2182 ;TODO - subscribe to ICR
;
;
BLDVMR(DFN) ; Build VMR Message
;
;Input:
; DFN - Patient (#2) IEN
;
;Returns:
; Message in ^TMP("PXVWMSG",$J)
;
D BLD^PXVWMSG(DFN,"VMR MESSAGE")
;
Q
;
;
HASH() ;
I '$D(^TMP("PXVWMSG",$J)) Q ""
Q $$GENAREF^XLFSHAN(512,$NA(^TMP("PXVWMSG",$J)),1)
;
;
GETIMM(PXVARS,DFN) ; get immunizaion history
;
; Called from Build Logic in #920.77 during template processing.
;
N PXADMINDT,PXCNT,PXCVX,PXDAS,PXDOMAIN,PXVISIT
;
S PXDOMAIN=$$BASE^XLFUTL($$CRC16^XLFCRC($$KSP^XUPARAM("WHERE")),10,16)
S PXCNT=0
;
S PXCVX=""
F S PXCVX=$O(^PXRMINDX(9000010.11,"CVX","PI",DFN,PXCVX)) Q:PXCVX="" D
. S PXADMINDT=0
. F S PXADMINDT=$O(^PXRMINDX(9000010.11,"CVX","PI",DFN,PXCVX,PXADMINDT)) Q:PXADMINDT="" D
. . S PXDAS=0
. . F S PXDAS=$O(^PXRMINDX(9000010.11,"CVX","PI",DFN,PXCVX,PXADMINDT,PXDAS)) Q:'PXDAS D
. . . S PXCNT=PXCNT+1
. . . S PXVARS(PXCNT,"IEN")=PXDAS
. . . S PXVARS(PXCNT,"IMMUID")="urn:va:immunization:"_PXDOMAIN_":"_DFN_":"_PXDAS
. . . S PXVARS(PXCNT,"CVX")=PXCVX
. . . S PXVARS(PXCNT,"ADMINDT")=$E($$FMTHL7^XLFDT(PXADMINDT),1,8)
;
Q PXCNT
;
;
GETDEM(PXVARS,DFN) ; get demographics
;
; Called from Build Logic in #920.77 during template processing.
;
N PXDOB,PXSEX,VADM,VAHOW,VAPTYP,VAROOT
;
D DEM^VADPT
S PXDOB=$P(VADM(3),U,1)
S PXSEX=$P(VADM(5),U,1)
;
S PXVARS("DOB")=$E($$FMTHL7^XLFDT(PXDOB),1,8)
S PXVARS("SEX")=PXSEX
;
Q
;
;
GETREM(PXVARS,DFN,PXREMINDER) ; evaluate reminder
;
; Called from Build Logic in #920.77 during template processing.
;
;Input:
; PXVARS - Passed by reference (see output).
; DFN - Patient (#2) IEN
; PXREMINDER - Reminder Definition (#811.9) Name
;
;Returns:
; - The function will return:
; 1 - Positive finding
; 0 - No positive finding (or reminder definition doesn't exist)
; - PXVARS() array will be populated with values from the finding
; evaluation array (FIEVAL).
;
N PXFIEVAL,PXREMIEN
;
K ^TMP("PXRHM",$J)
K ^TMP("PXRM",$J)
;
I $G(PXREMINDER)="" Q 0
S PXREMIEN=$O(^PXD(811.9,"B",PXREMINDER,0)) ;ICR 3148 ; TODO - subscibe to ICR
I 'PXREMIEN Q 0
;
D MAINDF^PXRM(DFN,PXREMIEN,1,$$NOW^XLFDT) ;ICR 2182 ; TODO - subscibe to ICR
;
M PXFIEVAL=^TMP("PXRHM",$J,PXREMIEN,"FIEVAL")
I $G(PXFIEVAL(1))=0!($G(PXFIEVAL(1))="") Q 0 ; no positive findings
;
S PXVARS("DATE")=$E($$FMTHL7^XLFDT($G(PXFIEVAL(1,"DATE"))),1,8)
;TODO - Perhaps include other fields for future templating use
;
; TODO - When later displaing the ICE reccomendations, we might want
; to tie it back to these findings; if so, see what GPL did in this regard.
;
K ^TMP("PXRHM",$J)
K ^TMP("PXRM",$J)
;
Q 1
;
;
TESTVMR ; Build Test VMR Message
;
;Returns:
; Message in ^TMP("PXVWMSG",$J)
;
D BLD^PXVWMSG("","TEST VMR MESSAGE")
;
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXVWVMR 3184 printed Oct 16, 2024@18:32:56 Page 2
PXVWVMR ;ISP/LMT - Build VMR Message for input to ICE ;12/13/17 12:23
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**217**;Aug 12, 1996;Build 134
+2 ;
+3 ;
+4 ; Reference to ^PXD(811.9,"B", supported by ICR #3148 ; TODO - subscribe to ICR
+5 ; Reference to MAINDF^PXRM supported by ICR #2182 ;TODO - subscribe to ICR
+6 ;
+7 ;
BLDVMR(DFN) ; Build VMR Message
+1 ;
+2 ;Input:
+3 ; DFN - Patient (#2) IEN
+4 ;
+5 ;Returns:
+6 ; Message in ^TMP("PXVWMSG",$J)
+7 ;
+8 DO BLD^PXVWMSG(DFN,"VMR MESSAGE")
+9 ;
+10 QUIT
+11 ;
+12 ;
HASH() ;
+1 IF '$DATA(^TMP("PXVWMSG",$JOB))
QUIT ""
+2 QUIT $$GENAREF^XLFSHAN(512,$NAME(^TMP("PXVWMSG",$JOB)),1)
+3 ;
+4 ;
GETIMM(PXVARS,DFN) ; get immunizaion history
+1 ;
+2 ; Called from Build Logic in #920.77 during template processing.
+3 ;
+4 NEW PXADMINDT,PXCNT,PXCVX,PXDAS,PXDOMAIN,PXVISIT
+5 ;
+6 SET PXDOMAIN=$$BASE^XLFUTL($$CRC16^XLFCRC($$KSP^XUPARAM("WHERE")),10,16)
+7 SET PXCNT=0
+8 ;
+9 SET PXCVX=""
+10 FOR
SET PXCVX=$ORDER(^PXRMINDX(9000010.11,"CVX","PI",DFN,PXCVX))
if PXCVX=""
QUIT
Begin DoDot:1
+11 SET PXADMINDT=0
+12 FOR
SET PXADMINDT=$ORDER(^PXRMINDX(9000010.11,"CVX","PI",DFN,PXCVX,PXADMINDT))
if PXADMINDT=""
QUIT
Begin DoDot:2
+13 SET PXDAS=0
+14 FOR
SET PXDAS=$ORDER(^PXRMINDX(9000010.11,"CVX","PI",DFN,PXCVX,PXADMINDT,PXDAS))
if 'PXDAS
QUIT
Begin DoDot:3
+15 SET PXCNT=PXCNT+1
+16 SET PXVARS(PXCNT,"IEN")=PXDAS
+17 SET PXVARS(PXCNT,"IMMUID")="urn:va:immunization:"_PXDOMAIN_":"_DFN_":"_PXDAS
+18 SET PXVARS(PXCNT,"CVX")=PXCVX
+19 SET PXVARS(PXCNT,"ADMINDT")=$EXTRACT($$FMTHL7^XLFDT(PXADMINDT),1,8)
End DoDot:3
End DoDot:2
End DoDot:1
+20 ;
+21 QUIT PXCNT
+22 ;
+23 ;
GETDEM(PXVARS,DFN) ; get demographics
+1 ;
+2 ; Called from Build Logic in #920.77 during template processing.
+3 ;
+4 NEW PXDOB,PXSEX,VADM,VAHOW,VAPTYP,VAROOT
+5 ;
+6 DO DEM^VADPT
+7 SET PXDOB=$PIECE(VADM(3),U,1)
+8 SET PXSEX=$PIECE(VADM(5),U,1)
+9 ;
+10 SET PXVARS("DOB")=$EXTRACT($$FMTHL7^XLFDT(PXDOB),1,8)
+11 SET PXVARS("SEX")=PXSEX
+12 ;
+13 QUIT
+14 ;
+15 ;
GETREM(PXVARS,DFN,PXREMINDER) ; evaluate reminder
+1 ;
+2 ; Called from Build Logic in #920.77 during template processing.
+3 ;
+4 ;Input:
+5 ; PXVARS - Passed by reference (see output).
+6 ; DFN - Patient (#2) IEN
+7 ; PXREMINDER - Reminder Definition (#811.9) Name
+8 ;
+9 ;Returns:
+10 ; - The function will return:
+11 ; 1 - Positive finding
+12 ; 0 - No positive finding (or reminder definition doesn't exist)
+13 ; - PXVARS() array will be populated with values from the finding
+14 ; evaluation array (FIEVAL).
+15 ;
+16 NEW PXFIEVAL,PXREMIEN
+17 ;
+18 KILL ^TMP("PXRHM",$JOB)
+19 KILL ^TMP("PXRM",$JOB)
+20 ;
+21 IF $GET(PXREMINDER)=""
QUIT 0
+22 ;ICR 3148 ; TODO - subscibe to ICR
SET PXREMIEN=$ORDER(^PXD(811.9,"B",PXREMINDER,0))
+23 IF 'PXREMIEN
QUIT 0
+24 ;
+25 ;ICR 2182 ; TODO - subscibe to ICR
DO MAINDF^PXRM(DFN,PXREMIEN,1,$$NOW^XLFDT)
+26 ;
+27 MERGE PXFIEVAL=^TMP("PXRHM",$JOB,PXREMIEN,"FIEVAL")
+28 ; no positive findings
IF $GET(PXFIEVAL(1))=0!($GET(PXFIEVAL(1))="")
QUIT 0
+29 ;
+30 SET PXVARS("DATE")=$EXTRACT($$FMTHL7^XLFDT($GET(PXFIEVAL(1,"DATE"))),1,8)
+31 ;TODO - Perhaps include other fields for future templating use
+32 ;
+33 ; TODO - When later displaing the ICE reccomendations, we might want
+34 ; to tie it back to these findings; if so, see what GPL did in this regard.
+35 ;
+36 KILL ^TMP("PXRHM",$JOB)
+37 KILL ^TMP("PXRM",$JOB)
+38 ;
+39 QUIT 1
+40 ;
+41 ;
TESTVMR ; Build Test VMR Message
+1 ;
+2 ;Returns:
+3 ; Message in ^TMP("PXVWMSG",$J)
+4 ;
+5 DO BLD^PXVWMSG("","TEST VMR MESSAGE")
+6 ;
+7 QUIT
+8 ;
