iSharkFly-Open
/
VistA-ccr
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

changes for RPMS support - set ^TMP("GPLCCR","RPMS")=1

This commit is contained in:
george 2009-01-05 21:33:43 +00:00
parent 33576f4179
commit 4d505adf26
5 changed files with 50 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
p/CCRMEDS.m
View File

@ -37,6 +37,7 @@ EXTRACT(MEDXML,DFN,MEDOUTXML) ; EXTRACT MEDICATIONS INTO PROVIDED XML TEMPLATE
S @MEDTVMAP@(0)=0 ; INITIALIZE NUMBER OF MEDS PROCESSED
S MEDTARYTMP=$NA(^TMP("GPLCCR",$J,"MEDARYTMP"))
K @MEDTARYTMP ; KILL XML ARRAY
I $D(^TMP("GPLCCR","RPMS")) G USERPC ; FOR RPMS, USE THE RPC FOR MEDS
D EXTRACT^CCRMEDS1(MEDXML,DFN,MEDOUTXML) ; FIRST EXTRACT OUTPATIENT MEDS
I @MEDOUTXML@(0)>0 D ; CCRMEDS FOUND ACTIVE OP MEDS
. S HASOP=1 ; SET FLAG TO KNOW HOW TO ADD XML
@ -68,6 +69,7 @@ EXTRACT(MEDXML,DFN,MEDOUTXML) ; EXTRACT MEDICATIONS INTO PROVIDED XML TEMPLATE
THEND ;
Q ; SKIPPING ALL THE REST OF THIS LOGIC.. IT IS NOT GOING TO BE NEEDED
; ONCE NON-VA AND IP MEDS WORK (CCRMEDS3 AND CCRMEDS4)
USERPC ; ENTRY POINT FOR RPMS
N MEDRSLT,I,J,K,MEDPTMP,X,MEDVMAP,TBUF
D ACTIVE^ORWPS(.MEDRSLT,DFN)
I '$D(MEDRSLT(1)) D ; NO MEDS FOR THIS PATIENT, EXIT
@ -99,7 +101,7 @@ THEND ;
. ; W ZI," ",MEDCNT,!
. S ZJ=$P(ZA(ZI),U,1) ; INDEX OF FIRST LINE OF MED IN MEDRSLT
. S MEDPTMP=MEDRSLT(ZJ) ; PULL OUT FIRST LINE OF MED
. I $P(MEDPTMP,U,1)?1"~OP" Q ; SKIP OP ACTIVE AND PENDING
. ;I $P(MEDPTMP,U,1)?1"~OP" Q ; SKIP OP ACTIVE AND PENDING
. S MEDCNT=MEDCNT+1 ; WE ARE GOING TO ADD A MED
. S MEDVMAP=$NA(@MEDTVMAP@(MEDCNT)) ; START PAST OP ACTIVE MEDS
. S @MEDTVMAP@(0)=@MEDTVMAP@(0)+1 ; ADDING A MED HERE
@ -150,7 +152,7 @@ THEND ;
. . . N RXIEN ; IEN TO RX, EXAMPLE "~OP^13R;O^IBUPROFEN 400MG^" 13 IS IT
. . . S RXIEN=$$DIGITS($P($P(MEDPTMP,U,2),";",1)) ; GET JUST LEADING DIGITS
. . . I DEBUG W "RXIEN=",RXIEN,! ;
. . . D RX^PSO52API(DFN,"MEDCODE",RXIEN) ; EXTRACT THE RX RECORD TO ^TMP
. . . ;D RX^PSO52API(DFN,"MEDCODE",RXIEN) ; EXTRACT THE RX RECORD TO ^TMP
. . . I $D(^TMP($J,"MEDCODE",DFN,RXIEN,27)) D ; IF SUCCESS
. . . . S @MEDVMAP@("MEDPRODUCTNAMECODEVALUE")=^TMP($J,"MEDCODE",DFN,RXIEN,27)
. . . . S @MEDVMAP@("MEDPRODUCTNAMECODINGINGSYSTEM")="NDC"

9
p/CCRVA200.m
View File

@ -87,7 +87,7 @@ ADDTYPE(DUZ) ; Get Address Type, PUBLIC; EXTRINSIC
; OUTPUT: At this point "Work"
Q "Work"
;
ADDLINE1(DUZ) ; Get Address associated with this instituation; PUBLIC; EXTRINSIC
ADDLINE1(ADUZ) ; Get Address associated with this instituation; PUBLIC; EXTRINSIC ; CHANGED PARAMETER TO ADUZ TO KEEP FROM CRASHING GPL 1/09
; INPUT: DUZ ByVal
; Output: String.
;
@ -110,7 +110,8 @@ ADDLINE1(DUZ) ; Get Address associated with this instituation; PUBLIC; EXTRINSIC
Q:$L(ADD) $P(ADD,U)
Q ""
;
CITY(DUZ) ; Get City for Institution. PUBLIC; EXTRINSIC
CITY(ADUZ) ; Get City for Institution. PUBLIC; EXTRINSIC
;GPL CHANGED PARAMETER TO ADUZ TO KEEP $$SITE^VASITE FROM CRASHING
; INPUT: DUZ ByVal
; Output: String.
; See ADD1 for comments
@ -122,7 +123,7 @@ CITY(DUZ) ; Get City for Institution. PUBLIC; EXTRINSIC
Q:$L(ADD) $P(ADD,U,2)
Q ""
;
STATE(DUZ) ; Get State for Institution. PUBLIC; EXTRINSIC
STATE(ADUZ) ; Get State for Institution. PUBLIC; EXTRINSIC
; INPUT: DUZ ByVal
; Output: String.
; See ADD1 for comments
@ -134,7 +135,7 @@ STATE(DUZ) ; Get State for Institution. PUBLIC; EXTRINSIC
Q:$L(ADD) $P(ADD,U,3)
Q ""
;
POSTCODE(DUZ) ; Get Postal Code for Institution. PUBLIC; EXTRINSIC
POSTCODE(ADUZ) ; Get Postal Code for Institution. PUBLIC; EXTRINSIC
; INPUT: DUZ ByVal
; OUTPUT: String.
; See ADD1 for comments

47
p/GPLLABS.m
View File

@ -70,30 +70,47 @@ RPCMAP(RTN,DFN,RMIVAR,RMIXML) ; RPC ENTRY POINT FOR MAPPING RESULTS
N C0CI,C0CJ,C0CMAP,C0CTMAP,C0CTMP
S C0CIN=@C0CV@(0) ; COUNT OF RESULTS (OBR)
N C0CRTMP ; AREA TO BUILD ONE RESULT REQUEST AND ALL TESTS FOR IT
N C0CRBASE S C0CRBASE=$NA(^TMP($J,"TESTTMP")) ;WORK AREA
N C0CRBLD ; BUILD LIST FOR XML - THE BUILD IS DELAYED UNTIL THE END
; TO IMPROVE PERFORMANCE
D QUEUE^GPLXPATH("C0CRBLD","C0CRT",1,1) ;<Results>
F C0CI=1:1:C0CIN D ; LOOP THROUGH VARIABLES
. K C0CMAP,C0CTMP,C0CRTMP ;EMPTY OUT LAST BATCH OF VARIABLES
. K C0CMAP,C0CTMP ;EMPTY OUT LAST BATCH OF VARIABLES
. S C0CRTMP=$NA(@C0CRBASE@(C0CI)) ;PARTITION OF WORK AREA FOR EACH TEST
. S C0CMAP=$NA(@C0CV@(C0CI)) ;
. I 'C0CQT W "MAPOBR:",C0CMAP,!
. ;MAPPING FOR TEST REQUEST GOES HERE
. D MAP^GPLXPATH("C0CRT",C0CMAP,"C0CRTMP") ; MAP OBR DATA
. D MAP^GPLXPATH("C0CRT",C0CMAP,C0CRTMP) ; MAP OBR DATA
. ;D QOPEN^GPLXPATH("C0CRBLD",C0CRTMP,C0CIS) ;1ST PART OF XML
. D QUEUE^GPLXPATH("C0CRBLD",C0CRTMP,2,@C0CRTMP@(0)-4) ;UP TO <Test>
. I $D(@C0CMAP@("M","TESTS",0)) D ; TESTS EXIST
. . S C0CJN=@C0CMAP@("M","TESTS",0) ; NUMBER OF TESTS
. . K C0CTO ; CLEAR OUTPUT VARIABLE
. . F C0CJ=1:1:C0CJN D ;FOR EACH TEST RESULT
. . . K C0CTMAP,C0CTMP ; EMPTY MAPS FOR TEST RESULTS
. . . K C0CTMAP ; EMPTY MAPS FOR TEST RESULTS
. . . S C0CTMP=$NA(@C0CRBASE@(C0CI,C0CJ)) ;WORK AREA FOR TEST RESULTS
. . . S C0CTMAP=$NA(@C0CMAP@("M","TESTS",C0CJ)) ;
. . . I 'C0CQT W "MAPOBX:",C0CTMAP,!
. . . D MAP^GPLXPATH("C0CTT",C0CTMAP,"C0CTMP") ; MAP TO TMP
. . . D MAP^GPLXPATH("C0CTT",C0CTMAP,C0CTMP) ; MAP TO TMP
. . . I C0CJ=1 S C0CJS=2 E S C0CJS=1 ;FIRST TIME,SKIP THE <Test>
. . . I C0CJ=C0CJN S C0CJE=@C0CTMP@(0)-1 E S C0CJE=@C0CTMP@(0) ;</Test>
. . . S C0CJS=1 S C0CJE=@C0CTMP@(0) ; INSERT ALL OF THE TEXT XML
. . . D QUEUE^GPLXPATH("C0CRBLD",C0CTMP,C0CJS,C0CJE) ; ADD TO BUILD LIST
. . . ;I C0CJ=1 D ; FIRST TIME, JUST COPY
. . . ;. D CP^GPLXPATH("C0CTMP","C0CTO") ; START BUILDING TEST XML
. . . ;E D INSINNER^GPLXPATH("C0CTO","C0CTMP")
. . . ;
. . . D PUSHA^GPLXPATH("C0CTO","C0CTMP") ;ADD THE TEST TO BUFFER
. . . ;D PUSHA^GPLXPATH("C0CTO",C0CTMP) ;ADD THE TEST TO BUFFER
. . ; I 'C0CQT D PARY^GPLXPATH("C0CTO")
. . D INSINNER^GPLXPATH("C0CRTMP","C0CTO","//Results/Result/Test") ;INSERT TST
. I C0CI=1 D ; FIRST TIME, COPY INSTEAD OF INSERT
. . D CP^GPLXPATH("C0CRTMP","RTN") ;
. E D INSINNER^GPLXPATH("RTN","C0CRTMP") ; INSERT THIS TEST REQUEST
. . ;D INSINNER^GPLXPATH(C0CRTMP,"C0CTO","//Results/Result/Test") ;INSERT TST
. ;D QCLOSE^GPLXPATH("C0CRBLD",C0CRTMP,"//Results/Result/Test") ;END OF XML
. D QUEUE^GPLXPATH("C0CRBLD","C0CRT",C0CRT(0)-1,C0CRT(0)-1) ;</Result>
. ;I C0CI=1 D ; FIRST TIME, COPY INSTEAD OF INSERT
. . ;D CP^GPLXPATH(C0CRTMP,"RTN") ;
. ;E D INSINNER^GPLXPATH("RTN",C0CRTMP) ; INSERT THIS TEST REQUEST
D QUEUE^GPLXPATH("C0CRBLD","C0CRT",C0CRT(0),C0CRT(0)) ;</Results>
D BUILD^GPLXPATH("C0CRBLD","RTN") ;RENDER THE XML
K @C0CRBASE ; CLEAR OUT TEMPORARY STURCTURE
Q
;
EXTRACT(ILXML,DFN,OLXML) ; EXTRACT LABS INTO THE C0CLVAR GLOBAL
@ -179,6 +196,10 @@ LIST ; LIST THE HL7 MESSAGE; ALSO, EXTRACT THE RESULT VARIABLES TO C0CLB
. . . S XV("RESULTTESTCODEVALUE")=C0CVAR("C1") ; PRIMARY CODE VALUE
. . . S XV("RESULTTESTCODINGSYSTEM")=C0CVAR("C3") ; PRIMARY DISPLAY NAME
. . . S XV("RESULTTESTDESCRIPTIONTEXT")=C0CVAR("C2") ; USE PRIMARY TEXT
. . N C0CZG S C0CZG=XV("RESULTTESTNORMALDESCRIPTIONTEXT") ;
. . S XV("RESULTTESTNORMALDESCRIPTIONTEXT")=$$SYMENC^MXMLUTL(C0CZG) ;ESCAPE
. . S C0CZG=XV("RESULTTESTVALUE")
. . S XV("RESULTTESTVALUE")=$$SYMENC^MXMLUTL(C0CZG) ;ESCAPE
. I C0CTYP="OBX" D ; PROCESS TEST RESULTS
. . I C0CLOBX=0 D ; FIRST TEST RESULT FOR THIS SECTION
. . . S C0CLB2=$NA(@C0CLB@(C0CLI,"M","TESTS")) ; INDENT FOR TEST RESULTS
@ -220,6 +241,14 @@ LTYP(OSEG,OTYP,OVARA,OC0CQT) ;
LOBX ;
Q
;
OUT(DFN) ; WRITE OUT A CCR THAT HAS JUST BEEN PROCESSED (FOR TESTING)
N GA,GF,GD
S GA=$NA(^TMP("GPLCCR",$J,DFN,"CCR",1))
S GF="RPMS_CCR_"_DFN_"_"_DT_".xml"
S GD=^TMP("GPLCCR","ODIR")
W $$OUTPUT^GPLXPATH(GA,GF,GD)
Q
;
SETTBL ;
K X ; CLEAR X
S X("PID","PID1")="1^00104^Set ID - Patient ID"

3
p/GPLPROBS.m
View File

@ -32,7 +32,8 @@ EXTRACT(IPXML,DFN,OUTXML) ; EXTRACT PROBLEMS INTO PROVIDED XML TEMPLATE
S TVMAP=$NA(^TMP("GPLCCR",$J,"PROBVALS"))
S TARYTMP=$NA(^TMP("GPLCCR",$J,"PROBARYTMP"))
K @TVMAP,@TARYTMP ; KILL OLD ARRAY VALUES
D LIST^ORQQPL3(.RPCRSLT,DFN,"") ; CALL THE PROBLEM LIST RPC
;D LIST^ORQQPL3(.RPCRSLT,DFN,"") ; CALL THE PROBLEM LIST RPC
D GET^BGOPROB(.RPCRSLT,DFN) ; CALL THE PROBLEM LIST RPC
I '$D(RPCRSLT(1)) D Q ; RPC RETURNS NULL
. W "NULL RESULT FROM LIST^ORQQPL3 ",!
. S @OUTXML@(0)=0

1
p/GPLXPATH.m
View File

@ -371,6 +371,7 @@ MAP(IXML,INARY,OXML) ; SUBSTITUTE MULTIPLE @@X@@ VARS WITH VALUES IN INARY
. . . . I '$D(@INARY@(TNAM,"F")) D ; NOT A SPECIAL FIELD
. . . . . S TVAL=@INARY@(TNAM) ; PULL OUT MAPPED VALUE
. . . . E D DOFLD ; PROCESS A FIELD
. . . S TVAL=$$SYMENC^MXMLUTL(TVAL) ;MAKE SURE THE VALUE IS XML SAFE
. . . S TSTR=TSTR_TVAL_$P(@IXML@(I),"@@",J+1) ; ADD VAR AND PART AFTER
. . S @OXML@(I)=TSTR ; COPY LINE WITH MAPPED VALUES
. . I DEBUG W TSTR