Refactor of Med Routines, part 1

This commit is contained in:
sam 2009-03-29 20:19:05 +00:00
parent 2bf3550f5d
commit 67d0bf0a72
5 changed files with 655 additions and 661 deletions

View File

@ -40,30 +40,32 @@ EXTRACT(MEDXML,DFN,MEDOUTXML) ; Private; Extract medications into provided XML t
; 6. RPMS Meds are in C0CMED6. Need to create other routines for subdivisions of RPMS Meds is not known at this time.
;
; --Prep variables
D:$$RPMS^C0CUTIL() RPMS QUIT
D:($$VISTA^C0CUTIL())!($$WV^C0CUTIL()) VISTA QUIT
D EXTRACT^C0CMED1(MEDXML,DFN,MEDOUTXML) ; FIRST EXTRACT OUTPATIENT MEDS
I @MEDOUTXML@(0)>0 D ; C0CMED FOUND ACTIVE OP MEDS
. W "HAS ACTIVE OP MEDS",!
N PENDINGXML
S PENDINGXML="MEDPENDING" ;NAME FOR ARRAY
D EXTRACT^C0CMED2(MEDXML,DFN,PENDINGXML) ; FIRST EXTRACT OUTPATIENT MEDS
I @PENDINGXML@(0)>0 D ; C0CMED FOUND PENDING OP MEDS
. I @MEDOUTXML@(0)>0 D ; IF WE NEED TO COMBINE MEDS
. . D INSINNER^C0CXPATH(MEDOUTXML,PENDINGXML) ;ADD PENDING TO ACTIVE
. E D CP^C0CXPATH(PENDINGXML,MEDOUTXML) ; NO ACTIVE MEDS, JUST COPY
. W "HAS OP PENDING MEDS",!
N PENDINGXML
S PENDINGXML="MEDPENDING" ;NAME FOR ARRAY
D EXTRACT^C0CMED3(MEDXML,DFN,PENDINGXML) ; FIRST EXTRACT OUTPATIENT MEDS
I @PENDINGXML@(0)>0 D ; C0CMED FOUND PENDING OP MEDS
. I @MEDOUTXML@(0)>0 D ; IF WE NEED TO COMBINE MEDS
. . D INSINNER^C0CXPATH(MEDOUTXML,PENDINGXML) ;ADD NON-VA TO MEDS
. E D CP^C0CXPATH(PENDINGXML,MEDOUTXML) ; NO PREVIOUS MEDS, JUST COPY
. W:$G(DEBUG) "HAS NON-VA MEDS",!
Q
I $$RPMS^C0CUTIL() D RPMS QUIT
I ($$VISTA^C0CUTIL())!($$WV^C0CUTIL())!($$OV^C0CUTIL()) D VISTA QUIT
; Extraction Sections
RPMS
D EXTRACT^C0CMED6(MEDXML,DFN,MEDOUTXML) QUIT
VISTA
N MEDCOUNT S MEDCOUNT=0
N HIST S HIST=$NA(^TMP($J,"MED","HIST")) ; Meds already dispensed
N PEND S PEND=$NA(^TMP($J,"MED","PEND")) ; Pending Meds
N NVA S NVA=$NA(^TMP($J,"MED","NVA")) ; non-VA Meds
; N IPIV ; Inpatient IV Meds
; N IPUD ; Inpatient UD Meds
K ^TMP($J,"MED")
D EXTRACT^C0CMED1(MEDXML,DFN,HIST,.MEDCOUNT) ; Historical OP Meds
D EXTRACT^C0CMED2(MEDXML,DFN,PEND,.MEDCOUNT) ; Pending Meds
D EXTRACT^C0CMED3(MEDXML,DFN,NVA,.MEDCOUNT) ; non-VA Meds
I @HIST@(0)>0 D
. D CP^C0CXPATH(HIST,MEDOUTXML)
. W:$G(DEBUG) "HAS ACTIVE OP MEDS",!
I @PEND@(0)>0 D
. I @HIST@(0)>0 D INSINNER^C0CXPATH(MEDOUTXML,PEND) ;Add Pending to Historical
. E D CP^C0CXPATH(PEND,MEDOUTXML) ; No historical, just copy
. W:$G(DEBUG) "HAS OP PENDING MEDS",!
I @NVA@(0)>0 D
. I @HIST@(0)>0!(@PEND@(0)>0) D INSINNER^C0CXPATH(MEDOUTXML,NVA)
. E D CP^C0CXPATH(NVA,MEDOUTXML)
. W:$G(DEBUG) "HAS NON-VA MEDS",!
Q

View File

@ -21,7 +21,7 @@ C0CMED1 ; WV/CCDCCR/SMH - CCR/CCD PROCESSING FOR MEDICATIONS ;01/10/09
W "NO ENTRY FROM TOP",!
Q
;
EXTRACT(MINXML,DFN,OUTXML) ; EXTRACT MEDICATIONS INTO PROVIDED XML TEMPLATE
EXTRACT(MINXML,DFN,OUTXML,MEDCOUNT) ; EXTRACT MEDICATIONS INTO PROVIDED XML TEMPLATE
;
; INXML AND OUTXML ARE PASSED BY NAME SO GLOBALS CAN BE USED
; INXML WILL CONTAIN ONLY THE MEDICATIONS SECTION OF THE OVERALL TEMPLATE
@ -29,7 +29,7 @@ EXTRACT(MINXML,DFN,OUTXML) ; EXTRACT MEDICATIONS INTO PROVIDED XML TEMPLATE
; MEDS is return array from RPC.
; MAP is a mapping variable map (store result) for each med
; MED is holds each array element from MEDS(J), one medicine
; J is a counter.
; MEDCOUNT is a counter passed by Reference.
;
; RX^PSO52API is a Pharmacy Re-Enginnering (PRE) API to get all
; med data available.
@ -43,18 +43,14 @@ EXTRACT(MINXML,DFN,OUTXML) ; EXTRACT MEDICATIONS INTO PROVIDED XML TEMPLATE
; @(0) contains the number of meds or -1^NO DATA FOUND
; If it is -1, we quit.
I $P(MEDS(0),U)=-1 S @OUTXML@(0)=0 QUIT
I DEBUG ZWR MEDS
ZWRITE:$G(DEBUG) MEDS
N RXIEN S RXIEN=0
N MEDCOUNT S MEDCOUNT=0
S MEDMAP=$NA(^TMP("C0CCCR",$J,"MEDMAP")) ; THIS IS THE VARIABLE MAP
S MEDCOUNT=@MEDMAP@(0) ; ACCOUNT FOR MEDS ALREADY IN ARRAY
F S RXIEN=$O(MEDS(RXIEN)) Q:RXIEN="" D ; FOR EACH MEDICATION IN THE LIST
. S MEDCOUNT=MEDCOUNT+1
. I DEBUG W "RXIEN IS ",RXIEN,!
. W:$G(DEBUG) "RXIEN IS ",RXIEN,!
. S MAP=$NA(^TMP("C0CCCR",$J,"MEDMAP",MEDCOUNT))
. ; K @MAP DO NOT KILL HERE, WAS CLEARED IN C0CMED
. S @MEDMAP@(0)=@MEDMAP@(0)+1 ; INCREMENT TOTAL MEDS IN VAR ARRAY
. I DEBUG W "MAP= ",MAP,!
. W:$G(DEBUG) "MAP= ",MAP,!
. N MED M MED=MEDS(RXIEN) ; PULL OUT MEDICATION FROM
. S @MAP@("MEDOBJECTID")="MED"_MEDCOUNT ; MEDCOUNT FOR ID
. ; S @MAP@("MEDOBJECTID")="MED"_MED(.01) ;Rx Number
@ -206,10 +202,9 @@ EXTRACT(MINXML,DFN,OUTXML) ; EXTRACT MEDICATIONS INTO PROVIDED XML TEMPLATE
. N RESULT S RESULT=$NA(^TMP("C0CCCR",$J,"MAPPED"))
. K @RESULT
. D MAP^C0CXPATH(MINXML,MAP,RESULT)
. ; D PARY^C0CXPATH(RESULT)
. ; MAPPING DIRECTIONS
. N MEDDIR1,DIRXML1 S DIRXML1="MEDDIR1" ; VARIABLE AND NAME VARIABLE TEMPLATE
. N MEDDIR2,DIRXML2 S DIRXML2="MEDDIR2" ; VARIABLE AND NAME VARIABLE RESULT
. N DIRXML1 S DIRXML1="MEDDIR1" ; VARIABLE AND NAME VARIABLE TEMPLATE
. N DIRXML2 S DIRXML2="MEDDIR2" ; VARIABLE AND NAME VARIABLE RESULT
. D QUERY^C0CXPATH(MINXML,"//Medications/Medication/Directions",DIRXML1)
. D REPLACE^C0CXPATH(RESULT,"","//Medications/Medication/Directions")
. ; N MDZ1,MDZNA
@ -218,8 +213,8 @@ EXTRACT(MINXML,DFN,OUTXML) ; EXTRACT MEDICATIONS INTO PROVIDED XML TEMPLATE
. . . S MDZNA=$NA(@MAP@("M","DIRECTIONS",MDZ1))
. . . D MAP^C0CXPATH(DIRXML1,MDZNA,DIRXML2)
. . . D INSERT^C0CXPATH(RESULT,DIRXML2,"//Medications/Medication")
. D:MEDCOUNT=1 CP^C0CXPATH(RESULT,OUTXML) ; First one is a copy
. D:MEDCOUNT>1 INSINNER^C0CXPATH(OUTXML,RESULT) ; AFTER THE FIRST, INSERT INNER XML
. I MEDCOUNT=1 D CP^C0CXPATH(RESULT,OUTXML) ; First one is a copy
. E D INSINNER^C0CXPATH(OUTXML,RESULT) ; AFTER FIRST, INSERT INNER XML
N MEDTMP,MEDI
D MISSING^C0CXPATH(OUTXML,"MEDTMP") ; SEARCH XML FOR MISSING VARS
I MEDTMP(0)>0 D ; IF THERE ARE MISSING VARS - MARKED AS @@X@@

View File

@ -21,11 +21,12 @@ C0CMED2 ; WV/CCDCCR/SMH - CCR/CCD Meds - Pending for Vista
W "NO ENTRY FROM TOP",!
Q
;
EXTRACT(MINXML,DFN,OUTXML) ; EXTRACT MEDICATIONS INTO PROVIDED XML TEMPLATE
EXTRACT(MINXML,DFN,OUTXML,MEDCOUNT) ; EXTRACT MEDICATIONS INTO PROVIDED XML TEMPLATE
;
; MINXML is the Input XML Template, passed by name
; DFN is Patient IEN
; OUTXML is the resultant XML.
; DFN is Patient IEN (by Value)
; OUTXML is the resultant XML (by Name)
; MEDCOUNT is the current count of extracted meds, passed by Reference
;
; MEDS is return array from RPC.
; MAP is a mapping variable map (store result) for each med
@ -46,19 +47,15 @@ EXTRACT(MINXML,DFN,OUTXML) ; EXTRACT MEDICATIONS INTO PROVIDED XML TEM
; @(0) contains the number of meds or -1^NO DATA FOUND
; If it is -1, we quit.
I $P(MEDS(0),U)=-1 S @OUTXML@(0)=0 QUIT
I DEBUG ZWR MEDS
ZWRITE:$G(DEBUG) MEDS
N RXIEN S RXIEN=0
N MEDCOUNT S MEDCOUNT=0
N MEDFIRST S MEDFIRST=1 ; FLAG FOR FIRST MED IN THIS SECTION FOR MERGING
S MEDMAP=$NA(^TMP("C0CCCR",$J,"MEDMAP")) ; THIS IS THE VARIABLE MAP
S MEDCOUNT=@MEDMAP@(0) ; ACCOUNT FOR MEDS ALREADY IN ARRAY
F S RXIEN=$O(MEDS(RXIEN)) Q:RXIEN="B" D ; FOR EACH MEDICATION IN THE LIST
. I $$GET1^DIQ(52.41,RXIEN,2,"I")="RF" QUIT ; Dont' want refill request as a "pending" order
. S MEDCOUNT=MEDCOUNT+1
. I DEBUG W "RXIEN IS ",RXIEN,!
. S MAP=$NA(^TMP("C0CCCR",$J,"MEDMAP",MEDCOUNT))
. ; K @MAP DON'T KILL MAP HERE, IT IS DONE IN C0CMED
. S @MEDMAP@(0)=@MEDMAP@(0)+1 ; INCREMENT TOTAL MEDS IN VAR ARRAY
. I DEBUG W "MAP= ",MAP,!
. N MED M MED=MEDS(RXIEN) ; PULL OUT MEDICATION FROM
. S @MAP@("MEDOBJECTID")="MED_PENDING"_MEDCOUNT ; MEDCOUNT FOR ID
@ -264,7 +261,7 @@ EXTRACT(MINXML,DFN,OUTXML) ; EXTRACT MEDICATIONS INTO PROVIDED XML TEM
N MEDTMP,MEDI
D MISSING^C0CXPATH(OUTXML,"MEDTMP") ; SEARCH XML FOR MISSING VARS
I MEDTMP(0)>0 D ; IF THERE ARE MISSING VARS - MARKED AS @@X@@
. W "MEDICATION MISSING ",!
. W "Pending Medication MISSING ",!
. F MEDI=1:1:MEDTMP(0) W MEDTMP(MEDI),!
Q
;

View File

@ -21,11 +21,12 @@ C0CMED3 ; WV/CCDCCR/SMH - Meds: Non-VA/Outside Meds for Vista
W "NO ENTRY FROM TOP",!
Q
;
EXTRACT(MINXML,DFN,OUTXML) ; Extract medications into provided xml template
EXTRACT(MINXML,DFN,OUTXML,MEDCOUNT) ; Extract medications into provided xml template
;
; MINXML is the Input XML Template, passed by name
; DFN is Patient IEN
; OUTXML is the resultant XML.
; MINXML is the Input XML Template, (passed by name)
; DFN is Patient IEN (passed by value)
; OUTXML is the resultant XML (passed by name)
; MEDCOUNT is the number of Meds extracted so far (passed by reference)
;
; MEDS is return array from RPC.
; MAP is a mapping variable map (store result) for each med
@ -38,7 +39,7 @@ EXTRACT(MINXML,DFN,OUTXML) ; Extract medications into provided xml template
;
N MEDS,MAP
K ^TMP($J,"CCDCCR") ; PLEASE DON'T KILL ALL OF ^TMP($J) HERE!!!!
K NVA
N NVA
D GETS^DIQ(55,DFN,"52.2*","IE","NVA") ; Output in NVA in FDA array format.
; If NVA does not exist, then patient has no non-VA meds
I $D(NVA)=0 S @OUTXML@(0)=0 QUIT
@ -49,15 +50,12 @@ EXTRACT(MINXML,DFN,OUTXML) ; Extract medications into provided xml template
;
I DEBUG ZWR MEDS
N FDAIEN S FDAIEN=0 ; For use in $Order in the MEDS array.
S MEDMAP=$NA(^TMP("C0CCCR",$J,"MEDMAP"))
N MEDCOUNT S MEDCOUNT=@MEDMAP@(0) ; We already have meds in the array
N MEDFIRST S MEDFIRST=1 ; FLAG FOR FIRST MED PROCESSED HERE
F S FDAIEN=$O(MEDS(FDAIEN)) Q:FDAIEN="" D ; FOR EACH MEDICATION IN THE LIST
. N MED M MED=MEDS(FDAIEN)
. I MED(5,"I")!MED(6,"I") QUIT ; If disconinued, we don't want to pull it.
. S MEDCOUNT=MEDCOUNT+1
. S MAP=$NA(^TMP("C0CCCR",$J,"MEDMAP",MEDCOUNT))
. S @MEDMAP@(0)=@MEDMAP@(0)+1 ; INCREMENT TOTAL MEDS IN VAR ARRAY
. N RXIEN S RXIEN=$P(FDAIEN,",") ; First piece of FDAIEN is the number of the med for this patient
. I DEBUG W "RXIEN IS ",RXIEN,!
. I DEBUG W "MAP= ",MAP,!

View File

@ -126,5 +126,7 @@ RPMS() ; Are we running on an RPMS system rather than Vista?
Q $G(DUZ("AG"))="I" ; If User Agency is Indian Health Service
VISTA() ; Are we running on Vanilla Vista?
Q $G(DUZ("AG"))="V" ; If User Agency is VA
WV() ; Are we running on Customized Vista (WV or OpenVista)?
Q $G(DUZ("AG"))="E"!($G(DUZ("AG"))="O") ; Codes for WV and Other.
WV() ; Are we running on WorldVista?
Q $G(DUZ("AG"))="E" ; Code for WV.
OV() ; Are we running on OpenVista?
Q $G(DUZ("AG"))="O" ; Code for OpenVista