From e3cb27c3be5daddf7c0dacfcdda46233e7bf0dad Mon Sep 17 00:00:00 2001 From: george Date: Tue, 29 Jul 2008 20:57:24 +0000 Subject: [PATCH] improved handling of missing SSN and telephone values --- p/GPLACTORS.m | 75 ++++++++++++++++++++++++++++++++++----------------- p/GPLCCD.m | 60 ++++++++++++++++++++--------------------- p/GPLCCR0.m | 10 +++---- 3 files changed, 86 insertions(+), 59 deletions(-) diff --git a/p/GPLACTORS.m b/p/GPLACTORS.m index ffe06cc..d519808 100644 --- a/p/GPLACTORS.m +++ b/p/GPLACTORS.m @@ -16,24 +16,23 @@ GPLACTORS ; CCDCCR/GPL - CCR/CCD PROCESSING FOR ACTORS ; 7/3/08 ;You should have received a copy of the GNU General Public License along ;with this program; if not, write to the Free Software Foundation, Inc., ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - ; - ; PROCESS THE ACTORS SECTION OF THE CCR - ; - ; ===Revision History=== - ; 0.1 Initial Writing of Skeleton--GPL - ; 0.2 Patient Data Extraction--SMH - ; 0.3 Information System Info Extraction--SMH - ; + ; + ; PROCESS THE ACTORS SECTION OF THE CCR + ; + ; ===Revision History=== + ; 0.1 Initial Writing of Skeleton--GPL + ; 0.2 Patient Data Extraction--SMH + ; 0.3 Information System Info Extraction--SMH + ; EXTRACT(IPXML,ALST,AXML) ; EXTRACT ACTOR FROM ALST INTO PROVIDED XML TEMPLATE - ; IPXML is the Input Actor Template into which we are going to substitute values - ; This is straight XML. Values to be substituted are in @@VAL@@ format. + ; IPXML is the Input Actor Template into which we substitute values + ; This is straight XML. Values to be substituted are in @@VAL@@ format. + ; ALST is the actor list global generated by ACTLST^GPLCCR and has format: + ; ^TMP(7542,1,"ACTORS",0)=Count + ; ^TMP(7542,1,"ACTORS",n)="ActorID^ActorType^ActorIEN" + ; ActorType is an enum containing either "PROVIDER" "PATIENT" "SYSTEM" - ; ALST is the actor list global generated by ACTLST^GPLCCR and is in the following format - ; ^TMP(7542,1,"ACTORS",0)=Count - ; ^TMP(7542,1,"ACTORS",n)="ActorID^ActorType^ActorIEN" - ; ActorType is an enum containing either "PROVIDER" "PATIENT" "SYSTEM" - - ; AXML is the output arrary, to contain XML. + ; AXML is the output arrary, to contain XML. N I,J,AMAP,AOID,ATYP,AIEN D CP^GPLXPATH(IPXML,AXML) ; MAKE A COPY OF ACTORS XML @@ -89,21 +88,43 @@ PATIENT(INXML,AIEN,AOID,OUTXML) ; PROCESS A PATIENT ACTOR S @AMAP@("ACTORFAMILYNAME")=$$FAMILY^CCRDPT S @AMAP@("ACTORDATEOFBIRTH")=$$DOB^CCRDPT S @AMAP@("ACTORGENDER")=$$GENDER^CCRDPT - S @AMAP@("ACTORSSN")=$$SSN^CCRDPT - S @AMAP@("ACTORSSNSOURCEID")=AOID + S @AMAP@("ACTORSSN")="" + S @AMAP@("ACTORSSNTEXT")="" + S @AMAP@("ACTORSSNSOURCEID")="" + S ZX=$$SSN^CCRDPT + I ZX'="" D ; IF THERE IS A SSN IN THE RECORD + . S @AMAP@("ACTORSSN")=ZX + . S @AMAP@("ACTORSSNTEXT")="SSN" + . S @AMAP@("ACTORSSNSOURCEID")=AOID S @AMAP@("ACTORADDRESSTYPE")=$$ADDRTYPE^CCRDPT S @AMAP@("ACTORADDRESSLINE1")=$$ADDR1^CCRDPT S @AMAP@("ACTORADDRESSLINE2")=$$ADDR2^CCRDPT S @AMAP@("ACTORADDRESSCITY")=$$CITY^CCRDPT S @AMAP@("ACTORADDRESSSTATE")=$$STATE^CCRDPT S @AMAP@("ACTORADDRESSZIPCODE")=$$ZIP^CCRDPT - S @AMAP@("ACTORRESTEL")=$$RESTEL^CCRDPT - S @AMAP@("ACTORWORKTEL")=$$WORKTEL^CCRDPT - S @AMAP@("ACTORCELLTEL")=$$CELLTEL^CCRDPT + S @AMAP@("ACTORRESTEL")="" + S @AMAP@("ACTORRESTELTEXT")="" + S ZX=$$RESTEL^CCRDPT + I ZX'="" D ; IF THERE IS A RESIDENT PHONE IN THE RECORD + . S @AMAP@("ACTORRESTEL")=ZX + . S @AMAP@("ACTORRESTELTEXT")="Residential Telephone" + S @AMAP@("ACTORWORKTEL")="" + S @AMAP@("ACTORWORKTELTEXT")="" + S ZX=$$WORKTEL^CCRDPT + I ZX'="" D ; IF THERE IS A RESIDENT PHONE IN THE RECORD + . S @AMAP@("ACTORWORKTEL")=ZX + . S @AMAP@("ACTORWORKTELTEXT")="Work Telephone" + S @AMAP@("ACTORCELLTEL")="" + S @AMAP@("ACTORCELLTELTEXT")="" + S ZX=$$CELLTEL^CCRDPT + I ZX'="" D ; IF THERE IS A CELL PHONE IN THE RECORD + . S @AMAP@("ACTORCELLTEL")=ZX + . S @AMAP@("ACTORCELLTELTEXT")="Cell Phone" S @AMAP@("ACTOREMAIL")=$$EMAIL^CCRDPT S @AMAP@("ACTORADDRESSSOURCEID")=AOID S @AMAP@("ACTORIEN")=AIEN - S @AMAP@("ACTORSUFFIXNAME")="" ; DOES VISTA STORE THE SUFFIX? + S @AMAP@("ACTORSUFFIXNAME")="" ; DOES VISTA STORE THE SUFFIX + S @AMAP@("ACTORSOURCEID")="ACTORSYSTEM_1" ; THE SYSTEM IS THE SOURCE D DESTROY^CCRDPT D MAP^GPLXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE Q @@ -129,6 +150,7 @@ NOK(INXML,AIEN,AOID,OUTXML) ; PROCESS A NEXT OF KIN TYPE ACTOR S @AMAP@("ACTORDISPLAYNAME")="" S @AMAP@("ACTORRELATION")="" S @AMAP@("ACTORRELATIONSOURCEID")="" + S @AMAP@("ACTORSOURCEID")="ACTORSYSTEM_1" ; THE SYSTEM IS THE SOURCE D MAP^GPLXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE Q ; @@ -162,10 +184,15 @@ PROVIDER(INXML,AIEN,AOID,OUTXML) ; PROCESS A PROVIDER TYPE ACTOR S @AMAP@("ACTORADDRESSCITY")=$$CITY^CCRVA200(AIEN) S @AMAP@("ACTORADDRESSSTATE")=$$STATE^CCRVA200(AIEN) S @AMAP@("ACTORPOSTALCODE")=$$POSTCODE^CCRVA200(AIEN) - S @AMAP@("ACTORTELEPHONE")=$$TEL^CCRVA200(AIEN) - S @AMAP@("ACTORTELEPHONETYPE")=$$TELTYPE^CCRVA200(AIEN) + S @AMAP@("ACTORTELEPHONE")="" + S @AMAP@("ACTORTELEPHONETYPE")="" + S ZX=$$TEL^CCRVA200(AIEN) + I ZX'="" D ; THERE IS A PHONE NUMBER AVAILABLE + . S @AMAP@("ACTORTELEPHONE")=ZX + . S @AMAP@("ACTORTELEPHONETYPE")=$$TELTYPE^CCRVA200(AIEN) S @AMAP@("ACTOREMAIL")=$$EMAIL^CCRVA200(AIEN) S @AMAP@("ACTORADDRESSSOURCEID")="ACTORSYSTEM_1" + S @AMAP@("ACTORSOURCEID")="ACTORSYSTEM_1" ; THE SYSTEM IS THE SOURCE D MAP^GPLXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE Q ; diff --git a/p/GPLCCD.m b/p/GPLCCD.m index 851649c..476d4ac 100644 --- a/p/GPLCCD.m +++ b/p/GPLCCD.m @@ -24,8 +24,8 @@ EXPORT ; EXPORT ENTRY POINT FOR CCR S DIC=2,DIC(0)="AEMQ" D ^DIC I Y<1 Q ; EXIT S DFN=$P(Y,U,1) ; SET THE PATIENT - ; N CCRGLO - D CCDRPC(.CCRGLO,DFN,"CCD","","","") + ; N CCDGLO + D CCDRPC(.CCDGLO,DFN,"CCD","","","") S OARY=$NA(^TMP("GPLCCR",$J,DFN,"CCD",1)) S ONAM="PAT_"_DFN_"_CCD_V1.xml" S ODIRGLB=$NA(^TMP("GPLCCR","ODIR")) @@ -52,42 +52,42 @@ CCDRPC(CCRGRTN,DFN,CCRPART,TIME1,TIME2,HDRARY) ;RPC ENTRY POINT FOR CCR OUTPUT N CCD S CCD=0 ; FLAG FOR PROCESSING A CCD I CCRPART="CCD" S CCD=1 ; WE ARE PROCESSING A CCD S TGLOBAL=$NA(^TMP("GPLCCR",$J,"TEMPLATE")) ; GLOBAL FOR STORING TEMPLATE - I CCD S CCRGLO=$NA(^TMP("GPLCCR",$J,DFN,"CCD")) ; GLOBAL FOR THE CCD - E S CCRGLO=$NA(^TMP("GPLCCR",$J,DFN,"CCR")) ; GLOBAL FOR BUILDING THE CCR + I CCD S CCDGLO=$NA(^TMP("GPLCCR",$J,DFN,"CCD")) ; GLOBAL FOR THE CCD + E S CCDGLO=$NA(^TMP("GPLCCR",$J,DFN,"CCR")) ; GLOBAL FOR BUILDING THE CCR S ACTGLO=$NA(^TMP("GPLCCR",$J,DFN,"ACTORS")) ; GLOBAL FOR ALL ACTORS ; TO GET PART OF THE CCR RETURNED, PASS CCRPART="PROBLEMS" ETC S CCRGRTN=$NA(^TMP("GPLCCR",$J,DFN,CCRPART)) ; RTN GLO NM OF PART OR ALL I CCD D LOAD^GPLCCD1(TGLOBAL) ; LOAD THE CCR TEMPLATE E D LOAD^GPLCCR0(TGLOBAL) ; LOAD THE CCR TEMPLATE - D CP^GPLXPATH(TGLOBAL,CCRGLO) ; COPY THE TEMPLATE TO CCR GLOBAL + D CP^GPLXPATH(TGLOBAL,CCDGLO) ; COPY THE TEMPLATE TO CCR GLOBAL N CAPSAVE,CAPSAVE2 ; FOR HOLDING THE CCD ROOT LINES S CAPSAVE=@TGLOBAL@(3) ; SAVE THE CCD ROOT S CAPSAVE2=@TGLOBAL@(@TGLOBAL@(0)) ; SAVE LAST LINE OF CCD - S @CCRGLO@(3)="" ; CAP WITH CCR ROOT - S @TGLOBAL@(3)=@CCRGLO@(3) ; CAP THE TEMPLATE TOO - S @CCRGLO@(@CCRGLO@(0))="" ; FINISH CAP + S @CCDGLO@(3)="" ; CAP WITH CCR ROOT + S @TGLOBAL@(3)=@CCDGLO@(3) ; CAP THE TEMPLATE TOO + S @CCDGLO@(@CCDGLO@(0))="" ; FINISH CAP S @TGLOBAL@(@TGLOBAL@(0))="" ; FINISH CAP TEMP ; ; DELETE THE BODY, ACTORS AND SIGNATURES SECTIONS FROM GLOBAL ; THESE WILL BE POPULATED AFTER CALLS TO THE XPATH ROUTINES - D REPLACE^GPLXPATH(CCRGLO,"","//ContinuityOfCareRecord/Body") - D REPLACE^GPLXPATH(CCRGLO,"","//ContinuityOfCareRecord/Actors") - I 'CCD D REPLACE^GPLXPATH(CCRGLO,"","//ContinuityOfCareRecord/Signatures") - I DEBUG F I=1:1:@CCRGLO@(0) W @CCRGLO@(I),! + D REPLACE^GPLXPATH(CCDGLO,"","//ContinuityOfCareRecord/Body") + D REPLACE^GPLXPATH(CCDGLO,"","//ContinuityOfCareRecord/Actors") + I 'CCD D REPLACE^GPLXPATH(CCDGLO,"","//ContinuityOfCareRecord/Signatures") + I DEBUG F I=1:1:@CCDGLO@(0) W @CCDGLO@(I),! ; - I 'CCD D HDRMAP(CCRGLO,DFN,HDRARY) ; MAP HEADER VARIABLES + I 'CCD D HDRMAP(CCDGLO,DFN,HDRARY) ; MAP HEADER VARIABLES ; MAPPING THE PATIENT PORTION OF THE CDA HEADER S ZX="//ContinuityOfCareRecord/recordTarget/patientRole/patient" - D QUERY^GPLXPATH(CCRGLO,ZX,"ACTT1") + D QUERY^GPLXPATH(CCDGLO,ZX,"ACTT1") D PATIENT^GPLACTORS("ACTT1",DFN,"ACTORPATIENT_"_DFN,"ACTT2") ; MAP PATIENT I DEBUG D PARY^GPLXPATH("ACTT2") - D REPLACE^GPLXPATH(CCRGLO,"ACTT2",ZX) - I DEBUG D PARY^GPLXPATH(CCRGLO) + D REPLACE^GPLXPATH(CCDGLO,"ACTT2",ZX) + I DEBUG D PARY^GPLXPATH(CCDGLO) K ACTT1 K ACCT2 ; MAPPING THE PROVIDER ORGANIZATION,AUTHOR,INFORMANT,CUSTODIAN CDA HEADER ; FOR NOW, THEY ARE ALL THE SAME AND RESOLVE TO ORGANIZATION - D ORG^GPLACTORS(CCRGLO,DFN,"ACTORPATIENTORGANIZATION","ACTT2") ; MAP ORG - D CP^GPLXPATH("ACTT2",CCRGLO) + D ORG^GPLACTORS(CCDGLO,DFN,"ACTORPATIENTORGANIZATION","ACTT2") ; MAP ORG + D CP^GPLXPATH("ACTT2",CCDGLO) ; K ^TMP("GPLCCR",$J,"CCRSTEP") ; KILL GLOBAL PRIOR TO ADDING TO IT S CCRXTAB=$NA(^TMP("GPLCCR",$J,"CCRSTEP")) ; GLOBAL TO STORE CCR STEPS @@ -110,27 +110,27 @@ CCDRPC(CCRGRTN,DFN,CCRPART,TIME1,TIME2,HDRARY) ;RPC ENTRY POINT FOR CCR OUTPUT . I CCD D UNSHAVE("ITMP",OXML) . I CCD D UNMARK^GPLXPATH(OXML) ; REMOVE THE CCR MARKUP FROM SECTION . ; NOW INSERT THE RESULTS IN THE CCR BUFFER - . D INSERT^GPLXPATH(CCRGLO,OXML,"//ContinuityOfCareRecord/Body") + . D INSERT^GPLXPATH(CCDGLO,OXML,"//ContinuityOfCareRecord/Body") . I DEBUG F GPLI=1:1:@OXML@(0) W @OXML@(GPLI),! ; NEED TO ADD BACK IN ACTOR PROCESSING AFTER WE FIGURE OUT LINKAGE - ; D ACTLST^GPLCCR(CCRGLO,ACTGLO) ; GEN THE ACTOR LIST + ; D ACTLST^GPLCCR(CCDGLO,ACTGLO) ; GEN THE ACTOR LIST ; D QUERY^GPLXPATH(TGLOBAL,"//ContinuityOfCareRecord/Actors","ACTT") ; D EXTRACT^GPLACTORS("ACTT",ACTGLO,"ACTT2") - ; D INSINNER^GPLXPATH(CCRGLO,"ACTT2","//ContinuityOfCareRecord/Actors") + ; D INSINNER^GPLXPATH(CCDGLO,"ACTT2","//ContinuityOfCareRecord/Actors") N I,J,DONE S DONE=0 F I=0:0 D Q:DONE ; DELETE UNTIL ALL EMPTY ELEMENTS ARE GONE - . S J=$$TRIM^GPLXPATH(CCRGLO) ; DELETE EMPTY ELEMENTS + . S J=$$TRIM^GPLXPATH(CCDGLO) ; DELETE EMPTY ELEMENTS . W "TRIMMED",J,! . I J=0 S DONE=1 ; DONE WHEN TRIM RETURNS FALSE I CCD D ; TURN THE BODY INTO A CCD COMPONENT . N I - . F I=1:1:@CCRGLO@(0) D ; SEARCH THROUGH THE ENTIRE ARRAY - . . I @CCRGLO@(I)["" D ; REPLACE BODY MARKUP - . . . S @CCRGLO@(I)="" ; WITH CCD EQ - . . I @CCRGLO@(I)["" D ; REPLACE BODY MARKUP - . . . S @CCRGLO@(I)="" - S @CCRGLO@(3)=CAPSAVE ; UNCAP - TURN IT BACK INTO A CCD - S @CCRGLO@(@CCRGLO@(0))=CAPSAVE2 ; UNCAP LAST LINE + . F I=1:1:@CCDGLO@(0) D ; SEARCH THROUGH THE ENTIRE ARRAY + . . I @CCDGLO@(I)["" D ; REPLACE BODY MARKUP + . . . S @CCDGLO@(I)="" ; WITH CCD EQ + . . I @CCDGLO@(I)["" D ; REPLACE BODY MARKUP + . . . S @CCDGLO@(I)="" + S @CCDGLO@(3)=CAPSAVE ; UNCAP - TURN IT BACK INTO A CCD + S @CCDGLO@(@CCDGLO@(0))=CAPSAVE2 ; UNCAP LAST LINE Q ; INITSTPS(TAB) ; INITIALIZE CCR PROCESSING STEPS @@ -252,7 +252,7 @@ TLIST ; LIST THE TESTS ;;>>?G3(G3(0))["" ;;> ;;>>>D ZTEST^GPLCCR("CCR") - ;;>>>W $$TRIM^GPLXPATH(CCRGLO) + ;;>>>W $$TRIM^GPLXPATH(CCDGLO) ;;> ;;>>>K GPL S GPL="" ;;>>>D CCRRPC^GPLCCR(.GPL,"2","CCD","","","") diff --git a/p/GPLCCR0.m b/p/GPLCCR0.m index 5fb5266..6b11c02 100644 --- a/p/GPLCCR0.m +++ b/p/GPLCCR0.m @@ -551,7 +551,7 @@ LOAD(ARY) ; LOAD A CCR TEMPLATE INTO ARY PASSED BY NAME ;; ;; ;; - ;;SSN + ;;@@ACTORSSNTEXT@@ ;; ;;@@ACTORSSN@@ ;; @@ -573,19 +573,19 @@ LOAD(ARY) ; LOAD A CCR TEMPLATE INTO ARY PASSED BY NAME ;; ;;@@ACTORRESTEL@@ ;; - ;;Residential Telephone + ;;@@ACTORRESTELTEXT@@ ;; ;; ;; ;;@@ACTORWORKTEL@@ ;; - ;;Work Telephone + ;;@@ACTORWORKTELTEXT@@ ;; ;; ;; ;;@@ACTORCELLTEL@@ ;; - ;;Cell phone + ;;@@ACTORCELLTELTEXT@@ ;; ;; ;; @@ -690,7 +690,7 @@ LOAD(ARY) ; LOAD A CCR TEMPLATE INTO ARY PASSED BY NAME ;; ;; ;; - ;;@@ACTORSOURCEID + ;;@@ACTORSOURCEID@@ ;; ;; ;;