VPSMRAR9 ;WOIFO/BT - Get the last MRAR data for a patient;01/29/15 15:30
;;1.0;VA POINT OF SERVICE (KIOSKS);**3**;Jan 29, 2015;Build 64
;;Per VHA Directive 2004-038, this routine should not be modified.
;
Q
;IA #10103 - supported use of XLFDT functions
;IA #10104 - supported use of XLFSTR function
;
GET(VPSMRAR,VPSNUM,VPSTYP) ; RPC: VPS GET LAST MRAR
; INPUT
; VPSNUM : Parameter Value - patient SSN OR DFN OR ICN OR VIC/CAC (REQUIRED)
; VPSTYP : Parameter TYPE - SSN or DFN OR ICN OR VIC/CAC (REQUIRED)
; OUTPUT
; VPSMRAR: local array contains all field names/values for the last mrar
; WITH ERROR -> VPSMRAR(0) = -1 ^ error message
; SUCCESS -> VPSMRAR(0) = 1
; -> VPSMRAR(1..n) = FIELD NAME^SUBS^DATA
;
; -- validate input parameters
S VPSNUM=$G(VPSNUM)
S VPSTYP=$G(VPSTYP)
N VPSDFN S VPSDFN=$$VALIDATE^VPSRPC1(VPSTYP,VPSNUM)
I VPSDFN<1 S VPSMRAR(0)=-1_U_$P(VPSDFN,U,2) QUIT
;
; -- get last mrar ien for the patient
N LASTMRAR S LASTMRAR=$O(^VPS(853.5,VPSDFN,"MRAR","B",""),-1)
I 'LASTMRAR S VPSMRAR(0)=-1_U_"This patient has no MRAR transaction." QUIT
;
; -- retrieve transaction level fields and store them in VPSMRAR
D TRANS^VPSMR51(.VPSMRAR,VPSDFN,LASTMRAR)
;
; -- retrieve conducted with level fields and store them in VPSMRAR
D CNDWTH^VPSMR51(.VPSMRAR,VPSDFN,LASTMRAR)
;
; -- retrieve Allergy level fields and store them in VPSMRAR
D ALLERGY^VPSMR52(.VPSMRAR,VPSDFN,LASTMRAR)
;
; -- retrieve Additional Allergy level fields and store them in VPSMRAR
D ADDALLER^VPSMR52(.VPSMRAR,VPSDFN,LASTMRAR)
;
; -- retrieve Medication level fields and store them in VPSMRAR
D MEDS^VPSMR54(.VPSMRAR,VPSDFN,LASTMRAR)
;
; -- retrieve Additional Medication level fields and store them in VPSMRAR
D ADDMEDS^VPSMR54(.VPSMRAR,VPSDFN,LASTMRAR)
;
S VPSMRAR(0)=1
QUIT
;
ADD(VPSMRAR,FLDNAM,SUBS,INVAL,EXVAL) ;Add the record to VPSMRAR
; INPUT
; FLDNAM : Field name to store
; SUBS : Subscript (unique identifier for multiple values)
; INVAL : Fileman Internal Value
; EXVAL : Fileman Externall Value
; OUTPUT
; VPSMRAR: local array contains all field names/values for the last mrar
;
QUIT:INVAL=""&(EXVAL="")
N LAST S LAST=$O(VPSMRAR(""),-1)+1
I (EXVAL=INVAL) S INVAL=""
S VPSMRAR(LAST)=FLDNAM_U_SUBS_U_EXVAL_$S(INVAL="":"",1:U_INVAL)
QUIT
;
WP(REC,FIL,SUBS,FLD) ;return word-processing value
QUIT:$G(REC(FIL,SUBS,FLD,"E"))="" ""
;
N WP S WP=""
N LF S LF=$C(13,10)
N IDX S IDX=0
;
F S IDX=$O(REC(FIL,SUBS,FLD,IDX)) Q:'IDX D
. S WP=WP_REC(FIL,SUBS,FLD,IDX)_LF
;
QUIT $P(WP,LF,1,$L(WP,LF)-1)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVPSMRAR9 2665 printed Apr 09, 2024@21:45:30 Page 2
VPSMRAR9 ;WOIFO/BT - Get the last MRAR data for a patient;01/29/15 15:30
+1 ;;1.0;VA POINT OF SERVICE (KIOSKS);**3**;Jan 29, 2015;Build 64
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
+4 QUIT
+5 ;IA #10103 - supported use of XLFDT functions
+6 ;IA #10104 - supported use of XLFSTR function
+7 ;
GET(VPSMRAR,VPSNUM,VPSTYP) ; RPC: VPS GET LAST MRAR
+1 ; INPUT
+2 ; VPSNUM : Parameter Value - patient SSN OR DFN OR ICN OR VIC/CAC (REQUIRED)
+3 ; VPSTYP : Parameter TYPE - SSN or DFN OR ICN OR VIC/CAC (REQUIRED)
+4 ; OUTPUT
+5 ; VPSMRAR: local array contains all field names/values for the last mrar
+6 ; WITH ERROR -> VPSMRAR(0) = -1 ^ error message
+7 ; SUCCESS -> VPSMRAR(0) = 1
+8 ; -> VPSMRAR(1..n) = FIELD NAME^SUBS^DATA
+9 ;
+10 ; -- validate input parameters
+11 SET VPSNUM=$GET(VPSNUM)
+12 SET VPSTYP=$GET(VPSTYP)
+13 NEW VPSDFN
SET VPSDFN=$$VALIDATE^VPSRPC1(VPSTYP,VPSNUM)
+14 IF VPSDFN<1
SET VPSMRAR(0)=-1_U_$PIECE(VPSDFN,U,2)
QUIT
+15 ;
+16 ; -- get last mrar ien for the patient
+17 NEW LASTMRAR
SET LASTMRAR=$ORDER(^VPS(853.5,VPSDFN,"MRAR","B",""),-1)
+18 IF 'LASTMRAR
SET VPSMRAR(0)=-1_U_"This patient has no MRAR transaction."
QUIT
+19 ;
+20 ; -- retrieve transaction level fields and store them in VPSMRAR
+21 DO TRANS^VPSMR51(.VPSMRAR,VPSDFN,LASTMRAR)
+22 ;
+23 ; -- retrieve conducted with level fields and store them in VPSMRAR
+24 DO CNDWTH^VPSMR51(.VPSMRAR,VPSDFN,LASTMRAR)
+25 ;
+26 ; -- retrieve Allergy level fields and store them in VPSMRAR
+27 DO ALLERGY^VPSMR52(.VPSMRAR,VPSDFN,LASTMRAR)
+28 ;
+29 ; -- retrieve Additional Allergy level fields and store them in VPSMRAR
+30 DO ADDALLER^VPSMR52(.VPSMRAR,VPSDFN,LASTMRAR)
+31 ;
+32 ; -- retrieve Medication level fields and store them in VPSMRAR
+33 DO MEDS^VPSMR54(.VPSMRAR,VPSDFN,LASTMRAR)
+34 ;
+35 ; -- retrieve Additional Medication level fields and store them in VPSMRAR
+36 DO ADDMEDS^VPSMR54(.VPSMRAR,VPSDFN,LASTMRAR)
+37 ;
+38 SET VPSMRAR(0)=1
+39 QUIT
+40 ;
ADD(VPSMRAR,FLDNAM,SUBS,INVAL,EXVAL) ;Add the record to VPSMRAR
+1 ; INPUT
+2 ; FLDNAM : Field name to store
+3 ; SUBS : Subscript (unique identifier for multiple values)
+4 ; INVAL : Fileman Internal Value
+5 ; EXVAL : Fileman Externall Value
+6 ; OUTPUT
+7 ; VPSMRAR: local array contains all field names/values for the last mrar
+8 ;
+9 if INVAL=""&(EXVAL="")
QUIT
+10 NEW LAST
SET LAST=$ORDER(VPSMRAR(""),-1)+1
+11 IF (EXVAL=INVAL)
SET INVAL=""
+12 SET VPSMRAR(LAST)=FLDNAM_U_SUBS_U_EXVAL_$SELECT(INVAL="":"",1:U_INVAL)
+13 QUIT
+14 ;
WP(REC,FIL,SUBS,FLD) ;return word-processing value
+1 if $GET(REC(FIL,SUBS,FLD,"E"))=""
QUIT ""
+2 ;
+3 NEW WP
SET WP=""
+4 NEW LF
SET LF=$CHAR(13,10)
+5 NEW IDX
SET IDX=0
+6 ;
+7 FOR
SET IDX=$ORDER(REC(FIL,SUBS,FLD,IDX))
if 'IDX
QUIT
Begin DoDot:1
+8 SET WP=WP_REC(FIL,SUBS,FLD,IDX)_LF
End DoDot:1
+9 ;
+10 QUIT $PIECE(WP,LF,1,$LENGTH(WP,LF)-1)
