Changeset 313 for ccr/trunk

Timestamp:

Jan 5, 2009, 4:33:43 PM (15 years ago)

Author:

George Lilly

Message:

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

Location:

ccr/trunk/p

Files:

• CCRMEDS.m (modified) (4 diffs)
• CCRVA200.m (modified) (4 diffs)
• GPLLABS.m (modified) (3 diffs)
• GPLPROBS.m (modified) (1 diff)
• GPLXPATH.m (modified) (1 diff)

ccr/trunk/p/CCRMEDS.m

@@ -38 +38 @@
  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
@@ -69 +70 @@
  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)
@@ -100 +102 @@
  . 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
@@ -151 +153 @@
  . . . 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)

ccr/trunk/p/CCRVA200.m

@@ -88 +88 @@
         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.
@@ -111 +111 @@
         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.
@@ -123 +124 @@
         Q ""
         ;
-STATE(DUZ) ; Get State for Institution. PUBLIC; EXTRINSIC
+STATE(ADUZ) ; Get State for Institution. PUBLIC; EXTRINSIC
         ; INPUT: DUZ ByVal
         ; Output: String.
@@ -135 +136 @@
         Q ""
         ;
-POSTCODE(DUZ) ; Get Postal Code for Institution. PUBLIC; EXTRINSIC
+POSTCODE(ADUZ) ; Get Postal Code for Institution. PUBLIC; EXTRINSIC
         ; INPUT: DUZ ByVal
         ; OUTPUT: String.

ccr/trunk/p/GPLLABS.m

@@ -71 +71 @@
  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
  ;
@@ -180 +197 @@
  . . . 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
@@ -219 +240 @@
  Q
 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
  ;

ccr/trunk/p/GPLPROBS.m

@@ -33 +33 @@
           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 ",!

ccr/trunk/p/GPLXPATH.m

@@ -372 +372 @@
  . . . . . 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