Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: VPSMR54

VPSMR54.m

Go to the documentation of this file.
  1. VPSMR54 ;WOIFO/BT - Get the last MRAR data for a patient (Medication Level) ;01/29/15 15:30
  1. ;;1.0;VA POINT OF SERVICE (KIOSKS);**3**;Jan 29, 2015;Build 64
  1. ;;Per VHA Directive 2004-038, this routine should not be modified.
  1. ;
  1. ;
  1. MEDS(VPSMRAR,DFN,LASTMRAR) ; -- retrieve Medication level fields and store them in VPSMRAR
  1. ; INPUT
  1. ; DFN : Patient IEN
  1. ; LASTMRAR : The last MRAR Transaction IEN for the patient
  1. ; OUTPUT
  1. ; VPSMRAR: local array contains all field names/values for the last mrar
  1. ;
  1. N REC,INVAL,EXVAL,MEDNO,FLD,SUBS
  1. N FIL S FIL=853.54
  1. N MEDIEN S MEDIEN=0
  1. ;
  1. F S MEDIEN=$O(^VPS(853.5,DFN,"MRAR",LASTMRAR,"MEDS",MEDIEN)) Q:'MEDIEN D
  1. . S SUBS=MEDIEN_","_LASTMRAR_","_DFN_","
  1. . K REC D GETS^DIQ(FIL,SUBS,"*","IE","REC")
  1. . S MEDNO=REC(FIL,SUBS,.01,"I")
  1. . S FLD=""
  1. . F S FLD=$O(REC(FIL,SUBS,FLD)) Q:'FLD D
  1. . . K ATTR D FIELD^DID(FIL,FLD,"","LABEL;TYPE","ATTR")
  1. . . S INVAL=REC(FIL,SUBS,FLD,"I")
  1. . . S EXVAL=REC(FIL,SUBS,FLD,"E")
  1. . . I ATTR("TYPE")="WORD-PROCESSING" S EXVAL=$$WP^VPSMRAR9(.REC,FIL,SUBS,FLD),INVAL=""
  1. . . D ADD^VPSMRAR9(.VPSMRAR,ATTR("LABEL"),","_MEDNO,INVAL,EXVAL)
  1. . ;
  1. . D MEDIND(.VPSMRAR,DFN,LASTMRAR,MEDIEN,MEDNO)
  1. ;
  1. QUIT
  1. ;
  1. MEDIND(VPSMRAR,DFN,LASTMRAR,MEDIEN,MEDNO) ; -- retrieve Medication Indicator level fields and store them in VPSMRAR
  1. ; INPUT
  1. ; DFN : Patient IEN
  1. ; LASTMRAR : The last MRAR Transaction IEN for the patient
  1. ; MEDIEN : Medication IEN
  1. ; MEDNO : Medication Entry #
  1. ; OUTPUT
  1. ; VPSMRAR : local array contains all field names/values for the last mrar
  1. ;
  1. N REC,INVAL,EXVAL,ATTR,SUBS
  1. N FIL S FIL("MCHG")=853.5454,FIL("MCNFR")=853.5455,FIL("MDISCR")=853.5452
  1. N FLD S FLD=".01"
  1. ;
  1. F IND="MCHG","MCNFR","MDISCR" D
  1. . K ATTR D FIELD^DID(FIL(IND),FLD,"","LABEL;TYPE","ATTR")
  1. . N INDIEN S INDIEN=0
  1. . F S INDIEN=$O(^VPS(853.5,DFN,"MRAR",LASTMRAR,"MEDS",MEDIEN,IND,INDIEN)) Q:'INDIEN D
  1. . . S SUBS=INDIEN_","_MEDIEN_","_LASTMRAR_","_DFN_","
  1. . . K REC D GETS^DIQ(FIL(IND),SUBS,"*","IE","REC")
  1. . . S INVAL=REC(FIL(IND),SUBS,FLD,"I")
  1. . . S EXVAL=REC(FIL(IND),SUBS,FLD,"E")
  1. . . D ADD^VPSMRAR9(.VPSMRAR,ATTR("LABEL"),","_MEDNO_","_INVAL,INVAL,EXVAL)
  1. ;
  1. QUIT
  1. ;
  1. ADDMEDS(VPSMRAR,DFN,LASTMRAR) ; -- retrieve Additional Medication level fields and store them in VPSMRAR
  1. ; INPUT
  1. ; DFN : Patient IEN
  1. ; LASTMRAR : The last MRAR Transaction IEN for the patient
  1. ; OUTPUT
  1. ; VPSMRAR: local array contains all field names/values for the last mrar
  1. ;
  1. N REC,INVAL,EXVAL,MEDNO,FLD,SUBS
  1. N FIL S FIL=853.55
  1. N MEDIEN S MEDIEN=0
  1. ;
  1. F S MEDIEN=$O(^VPS(853.5,DFN,"MRAR",LASTMRAR,"MEDSADD",MEDIEN)) Q:'MEDIEN D
  1. . S SUBS=MEDIEN_","_LASTMRAR_","_DFN_","
  1. . K REC D GETS^DIQ(FIL,SUBS,"*","IE","REC")
  1. . S MEDNO=REC(FIL,SUBS,.01,"I")
  1. . S FLD=""
  1. . F S FLD=$O(REC(FIL,SUBS,FLD)) Q:'FLD D
  1. . . K ATTR D FIELD^DID(FIL,FLD,"","LABEL;TYPE","ATTR")
  1. . . S INVAL=REC(FIL,SUBS,FLD,"I")
  1. . . S EXVAL=REC(FIL,SUBS,FLD,"E")
  1. . . I ATTR("TYPE")="WORD-PROCESSING" S EXVAL=$$WP^VPSMRAR9(.REC,FIL,SUBS,FLD),INVAL=""
  1. . . D ADD^VPSMRAR9(.VPSMRAR,ATTR("LABEL"),","_MEDNO,INVAL,EXVAL)
  1. ;
  1. QUIT