VPREHL7.m

VPREHL7 ;ALB/MJK,MKB - VPR HL7 Message Processor ;10/25/18  15:29

 ;;1.0;VIRTUAL PATIENT RECORD;**8,14,30**;Sep 01, 2011;Build 9

 ;;Per VA Directive 6402, this routine should not be modified.

 ;

 ; External References          DBIA#

 ; -------------------          -----

 ; RMIM DRIVER                   6990

 ; VAFC ADT-A08 SERVER           4418

 ; DIQ                           2056

 ; MPIF001                       2701

 ; XLFDT                        10103

 ;

 ; Note: These variables are provided by the VistA HL7 system when a

 ;       subscriber protocol's ROUTING LOGIC is called:

 ;            - HLNEXT

 ;            - HLQUIT

 ;            - HLNODE

 ;            - HLFS

 ;            - HLECH

 ;

ADT ; -- main entry point for these VPR ADT client/router protocols:

 ;          - VPR ADT-A08 CLIENT protocol

 ;             o  subscribes to VAFC ADT-A08 SERVER 

 ;

 ; -- Posts A08 events for patient demographics changes

 ;    Scans for PID segment and uses embedded DFN

 ;    Sets ^VPR("AVPR"... freshness queue

 ;

 N DONE,VPRSEG,VPREVT,DFN

 S DONE=0

 F  X HLNEXT Q:HLQUIT'>0  D  Q:DONE

 . S VPRSEG=$E(HLNODE,1,3)

 . ;

 . I VPRSEG="EVN" D  Q

 . . S VPREVT=$P(HLNODE,HLFS,2)

 . . ;I VPREVT="A04" Q  ;no longer tracking registration events

 . . ; -- 97 reason = sensitive patient change occurred

 . . I VPREVT="A08" Q  ;,$P(HLNODE,HLFS,5)=97 Q  ;P14: all updates

 . . ; -- not an event VPR is interested in so done with message

 . . S DONE=1

 . ; -- PID segment always comes after EVN segment

 . I VPRSEG'="PID" Q

 . S DONE=1

 . ; -- VPREVT should always be defined at this point

 . I $G(VPREVT)="" Q

 . S DFN=+$P($P(HLNODE,HLFS,4),$E(HLECH))

 . I 'DFN Q

 . D QUE^VPRHS(DFN)

 Q

 ;

FIM ; -- main entry point for these VPR RMIM client/router protocols:

 ;          - VPR RMIM EVENTS protocol

 ;             o  subscribes to RMIM DRIVER

 ;

 N DONE,VPRSEG,DFN,CASE

 S DONE=0

 F  X HLNEXT Q:HLQUIT'>0  D  Q:DONE

 . S VPRSEG=$E(HLNODE,1,3)

 . ;

 . I VPRSEG'="PID" Q

 . S DONE=1

 . S DFN=+$P(HLNODE,HLFS,4) Q:DFN<1

 . S CASE=+$P($P(HLNODE,HLFS,5),$E(HLECH),2)

 . D POST^VPRHS(DFN,"Problem",CASE_";783")

 Q

 ;

PRF ; -- main entry point for these VPR PRF client/router protocols:

 ;          - VPR DGPF EVENTS protocol

 ;             o  subscribes to DGPF PRF ORU/R01 EVENT

 ;

 Q  ;replaced by new DGPF PRF EVENT protocol

 N DONE,VPRSEG,ICN,DFN,ID,STS,ACT

 S DONE=0

 F  X HLNEXT Q:HLQUIT'>0  D  Q:DONE

 . S VPRSEG=$E(HLNODE,1,3)

 . ;

 . I VPRSEG="PID" D  Q

 . . S ICN=$P($P(HLNODE,HLFS,4),$E(HLECH))

 . . S DFN=$$GETDFN^MPIF001(ICN)

 . . I DFN<1 S DONE=1

 . ;

 . I VPRSEG="OBR" D  Q

 . . S ID=+$P($P(HLNODE,HLFS,5),$E(HLECH))

 . . I ID<1 S DONE=1

 . ;

 . I VPRSEG'="OBX" Q

 . I $P(HLNODE,HLFS,3)'="ST" Q

 . S DONE=1 Q:$G(DFN)<1  Q:$G(ID)<1

 . S STS=$P(HLNODE,HLFS,6),ACT=$S(STS["INACT":"@",STS["ERROR":"@",1:"")

 . ;I STS="@" D POST^VPRHS(DFN,"Alert") Q  ;rebuild container

 . D POST^VPRHS(DFN,"Alert",ID_"~"_DFN_";26.13",ACT)

 Q

 ;

PSO ; -- main entry point for these VPR PRF client/router protocols:

 ;          - VPR PSO VDEF EVENTS protocol

 ;             o  subscribes to PSO VDEF RDS O13 OP PHARM PREF VS 

 ;             o  subscribes to PSO VDEF RDS O13 OP PHARM PPAR VS 

 ;

 N DONE,VPRSEG,ICN,DFN,ID,NOW,ORDER

 S DONE=0,NOW=$$NOW^XLFDT

 F  X HLNEXT Q:HLQUIT'>0  D  Q:DONE

 . S VPRSEG=$E(HLNODE,1,3)

 . ;

 . I VPRSEG="PID" D  Q

 . . S ICN=$P(HLNODE,HLFS,3)

 . . S DFN=$$GETDFN^MPIF001(ICN)

 . . I DFN<1 S DONE=1

 . ;

 . I VPRSEG'="ORC" Q

 . S ID=+$P($P(HLNODE,HLFS,4),$E(HLECH))

 . S DONE=1 Q:$G(DFN)<1  Q:$G(ID)<1

 . S ORDER=$$GET1^DIQ(52,ID,39.3,"I")

 . D:ORDER POST^VPRHS(DFN,"Medication",ORDER_";100")

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---VPREHL7   3726     printed  Feb 19, 2025@00:11:37                                                                                                                                                                                                     Page 2

VPREHL7   ;ALB/MJK,MKB - VPR HL7 Message Processor ;10/25/18  15:29

 +1       ;;1.0;VIRTUAL PATIENT RECORD;**8,14,30**;Sep 01, 2011;Build 9

 +2       ;;Per VA Directive 6402, this routine should not be modified.

 +3       ;

 +4       ; External References          DBIA#

 +5       ; -------------------          -----

 +6       ; RMIM DRIVER                   6990

 +7       ; VAFC ADT-A08 SERVER           4418

 +8       ; DIQ                           2056

 +9       ; MPIF001                       2701

 +10      ; XLFDT                        10103

 +11      ;

 +12      ; Note: These variables are provided by the VistA HL7 system when a

 +13      ;       subscriber protocol's ROUTING LOGIC is called:

 +14      ;            - HLNEXT

 +15      ;            - HLQUIT

 +16      ;            - HLNODE

 +17      ;            - HLFS

 +18      ;            - HLECH

 +19      ;

ADT       ; -- main entry point for these VPR ADT client/router protocols:

 +1       ;          - VPR ADT-A08 CLIENT protocol

 +2       ;             o  subscribes to VAFC ADT-A08 SERVER 

 +3       ;

 +4       ; -- Posts A08 events for patient demographics changes

 +5       ;    Scans for PID segment and uses embedded DFN

 +6       ;    Sets ^VPR("AVPR"... freshness queue

 +7       ;

 +8        NEW DONE,VPRSEG,VPREVT,DFN

 +9        SET DONE=0

 +10       FOR 

               XECUTE HLNEXT

               if HLQUIT'>0

                   QUIT 

               Begin DoDot:1

 +11               SET VPRSEG=$EXTRACT(HLNODE,1,3)

 +12      ;

 +13               IF VPRSEG="EVN"

                       Begin DoDot:2

 +14                       SET VPREVT=$PIECE(HLNODE,HLFS,2)

 +15      ;I VPREVT="A04" Q  ;no longer tracking registration events

 +16      ; -- 97 reason = sensitive patient change occurred

 +17      ;,$P(HLNODE,HLFS,5)=97 Q  ;P14: all updates

                           IF VPREVT="A08"

                               QUIT 

 +18      ; -- not an event VPR is interested in so done with message

 +19                       SET DONE=1

                       End DoDot:2

                       QUIT 

 +20      ; -- PID segment always comes after EVN segment

 +21               IF VPRSEG'="PID"

                       QUIT 

 +22               SET DONE=1

 +23      ; -- VPREVT should always be defined at this point

 +24               IF $GET(VPREVT)=""

                       QUIT 

 +25               SET DFN=+$PIECE($PIECE(HLNODE,HLFS,4),$EXTRACT(HLECH))

 +26               IF 'DFN

                       QUIT 

 +27               DO QUE^VPRHS(DFN)

               End DoDot:1

               if DONE

                   QUIT 

 +28       QUIT 

 +29      ;

FIM       ; -- main entry point for these VPR RMIM client/router protocols:

 +1       ;          - VPR RMIM EVENTS protocol

 +2       ;             o  subscribes to RMIM DRIVER

 +3       ;

 +4        NEW DONE,VPRSEG,DFN,CASE

 +5        SET DONE=0

 +6        FOR 

               XECUTE HLNEXT

               if HLQUIT'>0

                   QUIT 

               Begin DoDot:1

 +7                SET VPRSEG=$EXTRACT(HLNODE,1,3)

 +8       ;

 +9                IF VPRSEG'="PID"

                       QUIT 

 +10               SET DONE=1

 +11               SET DFN=+$PIECE(HLNODE,HLFS,4)

                   if DFN<1

                       QUIT 

 +12               SET CASE=+$PIECE($PIECE(HLNODE,HLFS,5),$EXTRACT(HLECH),2)

 +13               DO POST^VPRHS(DFN,"Problem",CASE_";783")

               End DoDot:1

               if DONE

                   QUIT 

 +14       QUIT 

 +15      ;

PRF       ; -- main entry point for these VPR PRF client/router protocols:

 +1       ;          - VPR DGPF EVENTS protocol

 +2       ;             o  subscribes to DGPF PRF ORU/R01 EVENT

 +3       ;

 +4       ;replaced by new DGPF PRF EVENT protocol

           QUIT 

 +5        NEW DONE,VPRSEG,ICN,DFN,ID,STS,ACT

 +6        SET DONE=0

 +7        FOR 

               XECUTE HLNEXT

               if HLQUIT'>0

                   QUIT 

               Begin DoDot:1

 +8                SET VPRSEG=$EXTRACT(HLNODE,1,3)

 +9       ;

 +10               IF VPRSEG="PID"

                       Begin DoDot:2

 +11                       SET ICN=$PIECE($PIECE(HLNODE,HLFS,4),$EXTRACT(HLECH))

 +12                       SET DFN=$$GETDFN^MPIF001(ICN)

 +13                       IF DFN<1

                               SET DONE=1

                       End DoDot:2

                       QUIT 

 +14      ;

 +15               IF VPRSEG="OBR"

                       Begin DoDot:2

 +16                       SET ID=+$PIECE($PIECE(HLNODE,HLFS,5),$EXTRACT(HLECH))

 +17                       IF ID<1

                               SET DONE=1

                       End DoDot:2

                       QUIT 

 +18      ;

 +19               IF VPRSEG'="OBX"

                       QUIT 

 +20               IF $PIECE(HLNODE,HLFS,3)'="ST"

                       QUIT 

 +21               SET DONE=1

                   if $GET(DFN)<1

                       QUIT 

                   if $GET(ID)<1

                       QUIT 

 +22               SET STS=$PIECE(HLNODE,HLFS,6)

                   SET ACT=$SELECT(STS["INACT":"@",STS["ERROR":"@",1:"")

 +23      ;I STS="@" D POST^VPRHS(DFN,"Alert") Q  ;rebuild container

 +24               DO POST^VPRHS(DFN,"Alert",ID_"~"_DFN_";26.13",ACT)

               End DoDot:1

               if DONE

                   QUIT 

 +25       QUIT 

 +26      ;

PSO       ; -- main entry point for these VPR PRF client/router protocols:

 +1       ;          - VPR PSO VDEF EVENTS protocol

 +2       ;             o  subscribes to PSO VDEF RDS O13 OP PHARM PREF VS 

 +3       ;             o  subscribes to PSO VDEF RDS O13 OP PHARM PPAR VS 

 +4       ;

 +5        NEW DONE,VPRSEG,ICN,DFN,ID,NOW,ORDER

 +6        SET DONE=0

           SET NOW=$$NOW^XLFDT

 +7        FOR 

               XECUTE HLNEXT

               if HLQUIT'>0

                   QUIT 

               Begin DoDot:1

 +8                SET VPRSEG=$EXTRACT(HLNODE,1,3)

 +9       ;

 +10               IF VPRSEG="PID"

                       Begin DoDot:2

 +11                       SET ICN=$PIECE(HLNODE,HLFS,3)

 +12                       SET DFN=$$GETDFN^MPIF001(ICN)

 +13                       IF DFN<1

                               SET DONE=1

                       End DoDot:2

                       QUIT 

 +14      ;

 +15               IF VPRSEG'="ORC"

                       QUIT 

 +16               SET ID=+$PIECE($PIECE(HLNODE,HLFS,4),$EXTRACT(HLECH))

 +17               SET DONE=1

                   if $GET(DFN)<1

                       QUIT 

                   if $GET(ID)<1

                       QUIT 

 +18               SET ORDER=$$GET1^DIQ(52,ID,39.3,"I")

 +19               if ORDER

                       DO POST^VPRHS(DFN,"Medication",ORDER_";100")

               End DoDot:1

               if DONE

                   QUIT 

 +20       QUIT