- 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 Feb 19, 2025@00:09:38 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)