SDES2GETMEDLIST ;ALB/JAS,JAS - SDES2 GET PATIENT'S MEDICATIONS LIST ; 27 Sept 2024 12:27 PM
;;5.3;Scheduling;**853,861**;Aug 13, 1993;Build 17
;;Per VHA Directive 6402, this routine should not be modified
;
Q
;
; Documented API's and Integration Agreements
; -------------------------------------------
; Reference to LIST^ORQQPS supported by ICR #1659
;
;
; RPC: SDES2 GET PATIENT MED LIST
;
; SDCONTEXT("ACHERON AUDIT ID") = 36 character unique ID number. Ex: 11d9dcc6-c6a2-4785-8031-8261576fca37
; SDCONTEXT("USER DUZ") = The DUZ of the user taking action on the calling application.
; SDCONTEXT("USER SECID") = The SECID of the user taking action on the calling application.
; SDCONTEXT("PATIENT DFN") = The DFN of the Veteran/user taking action on the calling application.
; SDCONTEXT("PATIENT ICN") = The ICN of the Veteran/user taking action on the calling application.
;
; PARAMS("DFN") = The DFN of the patient for Med List retrieval
; PARAMS("START DATE") = Start Date in ISO format (Optional - defaults to TODAY)
; PARAMS("END DATE") = End Date in ISO format (Optional - defaults to 9999999)
;
GETMEDLIST(JSONRETURN,SDCONTEXT,PARAMS) ; Get Patient's Medications List
;
N DTRANGE,SDDFN,SDERRORS,SDENDDT,SDSTRTDT,SDRETURN
;
; Validate SDCONTEXT
;
D VALCONTEXT^SDES2VALCONTEXT(.SDERRORS,.SDCONTEXT)
I $D(SDERRORS) M SDRETURN=SDERRORS S SDRETURN("Medication",1)="" D BUILDJSON^SDES2JSON(.JSONRETURN,.SDRETURN) Q
;
; Validate PARAMS
;
S DTRANGE=$$VALPARAMS(.PARAMS,.SDERRORS)
I $D(SDERRORS) M SDRETURN=SDERRORS S SDRETURN("Medication",1)="" D BUILDJSON^SDES2JSON(.JSONRETURN,.SDRETURN) Q
S SDSTRTDT=$P(DTRANGE,"^"),SDENDDT=$P(DTRANGE,"^",2)
;
; Retrieve Patient's Medications List
;
S SDDFN=PARAMS("DFN")
D MEDLIST(.SDRETURN,SDDFN,SDSTRTDT,SDENDDT)
;
; Build JSON return
;
I '$D(SDRETURN) S SDRETURN("Medication",1)=""
D BUILDJSON^SDES2JSON(.JSONRETURN,.SDRETURN)
Q
;
VALPARAMS(PARAMS,SDERRORS) ; Validate and Process DFNs
;
; Validate DFN
;
N VALRET
D VALFILEIEN^SDES2VALUTIL(.VALRET,.SDERRORS,2,$G(PARAMS("DFN")),1,0,1,2)
I 'VALRET,$D(SDERRORS) Q 0
;
; Validate Start/End Dates
;
N STRTDTISO,ENDDTISO,STRTDT,ENDDT,FMDATES
; Get the start and end date. Strip off time because we do not need it.
S STRTDTISO=$P($G(PARAMS("START DATE")),"T")
S ENDDTISO=$P($G(PARAMS("END DATE")),"T")
; Start date passed, but no end date - validate start date alone
I STRTDTISO'="",(ENDDTISO="") S FMDATES=$$VALISODTTM^SDES2VALISODTTM(.SDERRORS,STRTDTISO,,,498,499)
; Start date is not passed, but end date is passed
I STRTDTISO="",(ENDDTISO'="") S $P(FMDATES,U,2)=$$VALISODTTM^SDES2VALISODTTM(.SDERRORS,ENDDTISO,,,501,502)
; Both dates are passed in, validate the range
I STRTDTISO'="",(ENDDTISO'="") S FMDATES=$$VALISODATERANGE^SDES2VALISODTTM(.SDERRORS,STRTDTISO,ENDDTISO)
Q:$D(SDERRORS) 0
;
I $G(FMDATES)'="" S STRTDT=$P($G(FMDATES),U),ENDDT=$P($G(FMDATES),U,2)
I '$G(STRTDT) S STRTDT=DT
I '$G(ENDDT) S ENDDT=9999999
I ENDDT<STRTDT D ERRLOG^SDES2JSON(.SDERRORS,13)
Q STRTDT_"^"_ENDDT
;
MEDLIST(SDRETURN,SDDFN,SDSTRTDT,SDENDDT) ;
N MEDDATA,SDCOUNT,SDRESULT
;
; Call ORQQPS LIST
;
D LIST^ORQQPS(.SDRESULT,SDDFN,SDSTRTDT,SDENDDT)
; id^nameform^stop date^route^schedule/infusion rate^refills remaining
Q:'$D(SDRESULT)
;
; Patient's medication information
;
S SDCOUNT=0
F S SDCOUNT=$O(SDRESULT(SDCOUNT)) Q:'SDCOUNT I $D(SDRESULT(SDCOUNT)) D
. S MEDDATA=SDRESULT(SDCOUNT)
. ;
. ; Set med data fields for return
. ;
. S SDRETURN("Medication",SDCOUNT,"MedicationID")=$P(SDRESULT(SDCOUNT),"^")
. S SDRETURN("Medication",SDCOUNT,"MedicationName")=$P(SDRESULT(SDCOUNT),"^",2)
. S SDRETURN("Medication",SDCOUNT,"StopDate")=$$FMTISO^SDAMUTDT($P(SDRESULT(SDCOUNT),"^",3))
. S SDRETURN("Medication",SDCOUNT,"Route")=$P(SDRESULT(SDCOUNT),"^",4)
. S SDRETURN("Medication",SDCOUNT,"ScheduleInfusionRate")=$P(SDRESULT(SDCOUNT),"^",5)
. S SDRETURN("Medication",SDCOUNT,"RefillsRemaining")=$P(SDRESULT(SDCOUNT),"^",6)
;
K DRG,LSTDS,LSTFD,LSTRD ; Kill variables leaking from LIST^ORQQPS
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDES2GETMEDLIST 4225 printed Sep 23, 2025@20:30:40 Page 2
SDES2GETMEDLIST ;ALB/JAS,JAS - SDES2 GET PATIENT'S MEDICATIONS LIST ; 27 Sept 2024 12:27 PM
+1 ;;5.3;Scheduling;**853,861**;Aug 13, 1993;Build 17
+2 ;;Per VHA Directive 6402, this routine should not be modified
+3 ;
+4 QUIT
+5 ;
+6 ; Documented API's and Integration Agreements
+7 ; -------------------------------------------
+8 ; Reference to LIST^ORQQPS supported by ICR #1659
+9 ;
+10 ;
+11 ; RPC: SDES2 GET PATIENT MED LIST
+12 ;
+13 ; SDCONTEXT("ACHERON AUDIT ID") = 36 character unique ID number. Ex: 11d9dcc6-c6a2-4785-8031-8261576fca37
+14 ; SDCONTEXT("USER DUZ") = The DUZ of the user taking action on the calling application.
+15 ; SDCONTEXT("USER SECID") = The SECID of the user taking action on the calling application.
+16 ; SDCONTEXT("PATIENT DFN") = The DFN of the Veteran/user taking action on the calling application.
+17 ; SDCONTEXT("PATIENT ICN") = The ICN of the Veteran/user taking action on the calling application.
+18 ;
+19 ; PARAMS("DFN") = The DFN of the patient for Med List retrieval
+20 ; PARAMS("START DATE") = Start Date in ISO format (Optional - defaults to TODAY)
+21 ; PARAMS("END DATE") = End Date in ISO format (Optional - defaults to 9999999)
+22 ;
GETMEDLIST(JSONRETURN,SDCONTEXT,PARAMS) ; Get Patient's Medications List
+1 ;
+2 NEW DTRANGE,SDDFN,SDERRORS,SDENDDT,SDSTRTDT,SDRETURN
+3 ;
+4 ; Validate SDCONTEXT
+5 ;
+6 DO VALCONTEXT^SDES2VALCONTEXT(.SDERRORS,.SDCONTEXT)
+7 IF $DATA(SDERRORS)
MERGE SDRETURN=SDERRORS
SET SDRETURN("Medication",1)=""
DO BUILDJSON^SDES2JSON(.JSONRETURN,.SDRETURN)
QUIT
+8 ;
+9 ; Validate PARAMS
+10 ;
+11 SET DTRANGE=$$VALPARAMS(.PARAMS,.SDERRORS)
+12 IF $DATA(SDERRORS)
MERGE SDRETURN=SDERRORS
SET SDRETURN("Medication",1)=""
DO BUILDJSON^SDES2JSON(.JSONRETURN,.SDRETURN)
QUIT
+13 SET SDSTRTDT=$PIECE(DTRANGE,"^")
SET SDENDDT=$PIECE(DTRANGE,"^",2)
+14 ;
+15 ; Retrieve Patient's Medications List
+16 ;
+17 SET SDDFN=PARAMS("DFN")
+18 DO MEDLIST(.SDRETURN,SDDFN,SDSTRTDT,SDENDDT)
+19 ;
+20 ; Build JSON return
+21 ;
+22 IF '$DATA(SDRETURN)
SET SDRETURN("Medication",1)=""
+23 DO BUILDJSON^SDES2JSON(.JSONRETURN,.SDRETURN)
+24 QUIT
+25 ;
VALPARAMS(PARAMS,SDERRORS) ; Validate and Process DFNs
+1 ;
+2 ; Validate DFN
+3 ;
+4 NEW VALRET
+5 DO VALFILEIEN^SDES2VALUTIL(.VALRET,.SDERRORS,2,$GET(PARAMS("DFN")),1,0,1,2)
+6 IF 'VALRET
IF $DATA(SDERRORS)
QUIT 0
+7 ;
+8 ; Validate Start/End Dates
+9 ;
+10 NEW STRTDTISO,ENDDTISO,STRTDT,ENDDT,FMDATES
+11 ; Get the start and end date. Strip off time because we do not need it.
+12 SET STRTDTISO=$PIECE($GET(PARAMS("START DATE")),"T")
+13 SET ENDDTISO=$PIECE($GET(PARAMS("END DATE")),"T")
+14 ; Start date passed, but no end date - validate start date alone
+15 IF STRTDTISO'=""
IF (ENDDTISO="")
SET FMDATES=$$VALISODTTM^SDES2VALISODTTM(.SDERRORS,STRTDTISO,,,498,499)
+16 ; Start date is not passed, but end date is passed
+17 IF STRTDTISO=""
IF (ENDDTISO'="")
SET $PIECE(FMDATES,U,2)=$$VALISODTTM^SDES2VALISODTTM(.SDERRORS,ENDDTISO,,,501,502)
+18 ; Both dates are passed in, validate the range
+19 IF STRTDTISO'=""
IF (ENDDTISO'="")
SET FMDATES=$$VALISODATERANGE^SDES2VALISODTTM(.SDERRORS,STRTDTISO,ENDDTISO)
+20 if $DATA(SDERRORS)
QUIT 0
+21 ;
+22 IF $GET(FMDATES)'=""
SET STRTDT=$PIECE($GET(FMDATES),U)
SET ENDDT=$PIECE($GET(FMDATES),U,2)
+23 IF '$GET(STRTDT)
SET STRTDT=DT
+24 IF '$GET(ENDDT)
SET ENDDT=9999999
+25 IF ENDDT<STRTDT
DO ERRLOG^SDES2JSON(.SDERRORS,13)
+26 QUIT STRTDT_"^"_ENDDT
+27 ;
MEDLIST(SDRETURN,SDDFN,SDSTRTDT,SDENDDT) ;
+1 NEW MEDDATA,SDCOUNT,SDRESULT
+2 ;
+3 ; Call ORQQPS LIST
+4 ;
+5 DO LIST^ORQQPS(.SDRESULT,SDDFN,SDSTRTDT,SDENDDT)
+6 ; id^nameform^stop date^route^schedule/infusion rate^refills remaining
+7 if '$DATA(SDRESULT)
QUIT
+8 ;
+9 ; Patient's medication information
+10 ;
+11 SET SDCOUNT=0
+12 FOR
SET SDCOUNT=$ORDER(SDRESULT(SDCOUNT))
if 'SDCOUNT
QUIT
IF $DATA(SDRESULT(SDCOUNT))
Begin DoDot:1
+13 SET MEDDATA=SDRESULT(SDCOUNT)
+14 ;
+15 ; Set med data fields for return
+16 ;
+17 SET SDRETURN("Medication",SDCOUNT,"MedicationID")=$PIECE(SDRESULT(SDCOUNT),"^")
+18 SET SDRETURN("Medication",SDCOUNT,"MedicationName")=$PIECE(SDRESULT(SDCOUNT),"^",2)
+19 SET SDRETURN("Medication",SDCOUNT,"StopDate")=$$FMTISO^SDAMUTDT($PIECE(SDRESULT(SDCOUNT),"^",3))
+20 SET SDRETURN("Medication",SDCOUNT,"Route")=$PIECE(SDRESULT(SDCOUNT),"^",4)
+21 SET SDRETURN("Medication",SDCOUNT,"ScheduleInfusionRate")=$PIECE(SDRESULT(SDCOUNT),"^",5)
+22 SET SDRETURN("Medication",SDCOUNT,"RefillsRemaining")=$PIECE(SDRESULT(SDCOUNT),"^",6)
End DoDot:1
+23 ;
+24 ; Kill variables leaking from LIST^ORQQPS
KILL DRG,LSTDS,LSTFD,LSTRD
+25 QUIT
