From 4d505adf2646752fefc966c08543a5adf0e147e9 Mon Sep 17 00:00:00 2001 From: george Date: Mon, 5 Jan 2009 21:33:43 +0000 Subject: [PATCH] changes for RPMS support - set ^TMP("GPLCCR","RPMS")=1 --- p/CCRMEDS.m | 6 ++++-- p/CCRVA200.m | 9 +++++---- p/GPLLABS.m | 47 ++++++++++++++++++++++++++++++++++++++--------- p/GPLPROBS.m | 3 ++- p/GPLXPATH.m | 1 + 5 files changed, 50 insertions(+), 16 deletions(-) diff --git a/p/CCRMEDS.m b/p/CCRMEDS.m index 549bafc..9e3a971 100644 --- a/p/CCRMEDS.m +++ b/p/CCRMEDS.m @@ -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" diff --git a/p/CCRVA200.m b/p/CCRVA200.m index a0d702d..cbccadc 100644 --- a/p/CCRVA200.m +++ b/p/CCRVA200.m @@ -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 diff --git a/p/GPLLABS.m b/p/GPLLABS.m index bba44fc..29b7de2 100644 --- a/p/GPLLABS.m +++ b/p/GPLLABS.m @@ -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) ; 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 . 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 + . . . I C0CJ=C0CJN S C0CJE=@C0CTMP@(0)-1 E S C0CJE=@C0CTMP@(0) ; + . . . 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) ; + . ;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)) ; + 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" diff --git a/p/GPLPROBS.m b/p/GPLPROBS.m index 1974313..65166f1 100644 --- a/p/GPLPROBS.m +++ b/p/GPLPROBS.m @@ -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 diff --git a/p/GPLXPATH.m b/p/GPLXPATH.m index 7bc595d..15cb0b2 100644 --- a/p/GPLXPATH.m +++ b/p/GPLXPATH.m @@ -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