Index: ccr/trunk/CCRDPT.m =================================================================== --- ccr/trunk/CCRDPT.m (revision 6) +++ ccr/trunk/CCRDPT.m (revision 6) @@ -0,0 +1,133 @@ +CCRDPT ;CCRCCD/SMH - Routines to Extract Patient Data for CCDCCR; 6/15/08 + ;;0.1;CCRCCD;;Jun 15, 2008; + + ; NOTE TO PROGRAMMER: You need to call INIT(DPT) to initialize; and + ; DESTROY to clean-up. + + W "No Entry at top!" Q + + ; The following is a map of the relevant data in the patient global. + ; + ; ^DPT(D0,0)= (#.01) NAME [1F] ^ (#.02) SEX [2S] ^ (#.03) DATE OF BIRTH [3D] ^ + ; ==>^ (#.05) MARITAL STATUS [5P:11] ^ (#.06) RACE [6P:10] ^ (#.07) + ; ==>OCCUPATION [7F] ^ (#.08) RELIGIOUS PREFERENCE [8P:13] ^ (#.09) + ; ==>SOCIAL SECURITY NUMBER [9F] ^ (#.091) REMARKS [10F] ^ (#.092) + ; ==>PLACE OF BIRTH [CITY] [11F] ^ (#.093) PLACE OF BIRTH [STATE] + ; ==>[12P:5] ^ ^ (#.14) CURRENT MEANS TEST STATUS [14P:408.32] ^ + ; ==>(#.096) WHO ENTERED PATIENT [15P:200] ^ (#.097) DATE ENTERED INTO + ; ==>FILE [16D] ^ (#.098) HOW WAS PATIENT ENTERED? [17S] ^ (#.081) + ; ==>DUPLICATE STATUS [18S] ^ (#.082) PATIENT MERGED TO [19P:2] ^ + ; ==>(#.083) CHECK FOR DUPLICATE [20S] ^ (#.6) TEST PATIENT INDICATOR + ; ==>[21S] ^ + ; ^DPT(D0,.01,0)=^2.01^^ (#1) ALIAS + ; ^DPT(D0,.01,D1,0)= (#.01) ALIAS [1F] ^ (#1) ALIAS SSN [2F] ^ (#100.03) ALIAS + ; ==>COMPONENTS [3P:20] ^ + ; ^DPT(D0,.11)= (#.111) STREET ADDRESS [LINE 1] [1F] ^ (#.112) STREET ADDRESS + ; ==>[LINE 2] [2F] ^ (#.113) STREET ADDRESS [LINE 3] [3F] ^ (#.114) + ; ==>CITY [4F] ^ (#.115) STATE [5P:5] ^ (#.116) ZIP CODE [6F] ^ + ; ==>(#.117) COUNTY [7N] ^ ^ ^ ^ ^ (#.1112) ZIP+4 [12F] ^ + ; ==>(#.118) ADDRESS CHANGE DT/TM [13D] ^ (#.119) ADDRESS CHANGE + ; ==>SOURCE [14S] ^ (#.12) ADDRESS CHANGE SITE [15P:4] ^ (#.121) BAD + ; ==>ADDRESS INDICATOR [16S] ^ (#.122) ADDRESS CHANGE USER [17P:200] + ; ==>^ + ; ^DPT(D0,.121)= (#.1211) TEMPORARY STREET [LINE 1] [1F] ^ (#.1212) TEMPORARY + ; ==>STREET [LINE 2] [2F] ^ (#.1213) TEMPORARY STREET [LINE 3] [3F] + ; ==>^ (#.1214) TEMPORARY CITY [4F] ^ (#.1215) TEMPORARY STATE + ; ==>[5P:5] ^ (#.1216) TEMPORARY ZIP CODE [6F] ^ (#.1217) TEMPORARY + ; ==>ADDRESS START DATE [7D] ^ (#.1218) TEMPORARY ADDRESS END DATE + ; ==>[8D] ^ (#.12105) TEMPORARY ADDRESS ACTIVE? [9S] ^ (#.1219) + ; ==>TEMPORARY PHONE NUMBER [10F] ^ (#.12111) TEMPORARY ADDRESS + ; ==>COUNTY [11N] ^ (#.12112) TEMPORARY ZIP+4 [12F] ^ (#.12113) + ; ==>TEMPORARY ADDRESS CHANGE DT/TM [13D] ^ + ; ^DPT(D0,.121)= (#.12114) TEMPORARY ADDRESS CHANGE SITE [14P:4] ^ + ; ^DPT(D0,.13)= (#.131) PHONE NUMBER [RESIDENCE] [1F] ^ (#.132) PHONE NUMBER + ; ==>[WORK] [2F] ^ (#.133) EMAIL ADDRESS [3F] ^ (#.134) PHONE NUMBER + ; ==>[CELLULAR] [4F] ^ (#.135) PAGER NUMBER [5F] ^ (#.136) EMAIL + ; ==>ADDRESS CHANGE DT/TM [6D] ^ (#.137) EMAIL ADDRESS CHANGE SOURCE + ; ==>[7S] ^ (#.138) EMAIL ADDRESS CHANGE SITE [8P:4] ^ (#.139) + ; ==>CELLULAR NUMBER CHANGE DT/TM [9D] ^ (#.1311) CELLULAR NUMBER + ; ==>CHANGE SOURCE [10S] ^ (#.13111) CELLULAR NUMBER CHANGE SITE + ; ==>[11P:4] ^ (#.1312) PAGER NUMBER CHANGE DT/TM [12D] ^ (#.1313) + ; ==>PAGER NUMBER CHANGE SOURCE [13S] ^ (#.1314) PAGER NUMBER CHANGE + ; ==>SITE [14P:4] ^ + ; ^DPT(D0,.21)= (#.211) K-NAME OF PRIMARY NOK [1F] ^ (#.212) K-RELATIONSHIP TO + ; ==>PATIENT [2F] ^ (#.213) K-STREET ADDRESS [LINE 1] [3F] ^ (#.214) + ; ==>K-STREET ADDRESS [LINE 2] [4F] ^ (#.215) K-STREET ADDRESS [LINE + ; ==>3] [5F] ^ + ; ^DPT(D0,.21)= (#.216) K-CITY [6F] ^ (#.217) K-STATE [7P:5] ^ (#.218) K-ZIP + ; ==>CODE [8F] ^ (#.219) K-PHONE NUMBER [9F] ^ (#.2125) K-ADDRESS + ; ==>SAME AS PATIENT'S? [10S] ^ (#.21011) K-WORK PHONE NUMBER [11F] + ; ==>^ + ; ^DPT(D0,.211)= (#.2191) K2-NAME OF SECONDARY NOK [1F] ^ (#.2192) + ; ==>K2-RELATIONSHIP TO PATIENT [2F] ^ (#.2193) K2-STREET ADDRESS + ; ==>[LINE 1] [3F] ^ (#.2194) K2-STREET ADDRESS [LINE 2] [4F] ^ + ; ==>(#.2195) K2-STREET ADDRESS [LINE 3] [5F] ^ (#.2196) K2-CITY + ; ==>[6F] ^ (#.2197) K2-STATE [7P:5] ^ (#.2198) K2-ZIP CODE [8F] ^ + ; ==>(#.2199) K2-PHONE NUMBER [9F] ^ (#.21925) K2-ADDRESS SAME AS + ; ==>PATIENT'S? [10S] ^ (#.211011) K2-WORK PHONE NUMBER [11F] ^ + ; ^DPT(D0,.25)= (#.251) SPOUSE'S EMPLOYER NAME [1F] ^ (#.252) SPOUSE'S EMP + ; ==>STREET [LINE 1] [2F] ^ (#.253) SPOUSE'S EMP STREET [LINE 2] + ; ==>[3F] ^ (#.254) SPOUSE'S EMP STREET [LINE 3] [4F] ^ (#.255) + ; ==>SPOUSE'S EMPLOYER'S CITY [5F] ^ (#.256) SPOUSE'S EMPLOYER'S + ; ==>STATE [6P:5] ^ (#.257) SPOUSE'S EMP ZIP CODE [7F] ^ (#.258) + ; ==>SPOUSE'S EMP PHONE NUMBER [8F] ^ ^ ^ ^ ^ ^ (#.2514) + ; ==>SPOUSE'S OCCUPATION [14F] ^ (#.2515) SPOUSE'S EMPLOYMENT STATUS + ; ==>[15S] ^ (#.2516) SPOUSE'S RETIREMENT DATE [16D] ^ + ; ^DPT(D0,.33)= (#.331) E-NAME [1F] ^ (#.332) E-RELATIONSHIP TO PATIENT [2F] ^ + ; ==>(#.333) E-STREET ADDRESS [LINE 1] [3F] ^ (#.334) E-STREET + ; ==>ADDRESS [LINE 2] [4F] ^ (#.335) E-STREET ADDRESS [LINE 3] [5F] + ; ==>^ (#.336) E-CITY [6F] ^ (#.337) E-STATE [7P:5] ^ (#.338) E-ZIP + ; ==>CODE [8F] ^ (#.339) E-PHONE NUMBER [9F] ^ (#.3305) E-EMER. + ; ==>CONTACT SAME AS NOK? [10S] ^ (#.33011) E-WORK PHONE NUMBER + ; ==>[11F] ^ + +INIT(DFN) ; Copy DFN global to a local variable; PUBLIC + ; INPUT: Patient IEN (DFN) + ; OUTPUT: PT in the Symbol Table, representing the patient global + + ; Instead of accessing a global each single read (SLOOOOW) + ; read it off a local variable stored in Memory. + M PT=^DPT(DFN) + Q + ; +DESTROY ; Kill local variable; PUBLIC + ; INPUT: None + ; OUTPUT: Kill PT from the Symbol Table after you are done + K PT + Q + ; +FAMILY() ; Family Name; PUBLIC; Extrinsic + ; PREREQ: PT Defined + N NAME S NAME=$P(PT(0),"^",1) + D NAMECOMP^XLFNAME(.NAME) + Q NAME("FAMILY") + ; +GIVEN() ; Given Name; PUBLIC; Extrinsic + ; PREREQ: PT Defined + N NAME S NAME=$P(PT(0),"^",1) + D NAMECOMP^XLFNAME(.NAME) + Q NAME("GIVEN") + ; +MIDDLE() ; Middle Name; PUBLIC; Extrinsic + ; PREREQ: PT Defined + N NAME S NAME=$P(PT(0),"^",1) + D NAMECOMP^XLFNAME(.NAME) + Q NAME("MIDDLE") + ; +SUFFIX() ; Suffi Name; PUBLIC; Extrinsic + ; PREREQ: PT Defined + N NAME S NAME=$P(PT(0),"^",1) + D NAMECOMP^XLFNAME(.NAME) + Q NAME("SUFFIX") + ; +DISPNAME() ; Display Name; PUBLIC; Extrinsic + ; PREREQ: PT Defined + N NAME S NAME=$P(PT(0),"^",1) + Q $$NAMEFMT^XLFNAME(.NAME,"G","MXc") + ; "G" is Given Name First; "MXc" is Mixed Case, With Suffx Preceded by Comma +DOB() ; Date of Birth; PUBLIC; Extrinsic + ; PREREQ: PT Defined + N DOB S DOB=$P(PT(0),"^",3) + ; Date in FM Date Format. Convert to UTC/ISO 8601. + Q $$FMDTOUTC^CCRUTIL(DOB) + ; Index: ccr/trunk/CCRUTIL.m =================================================================== --- ccr/trunk/CCRUTIL.m (revision 6) +++ ccr/trunk/CCRUTIL.m (revision 6) @@ -0,0 +1,13 @@ +CCRUTIL ;CCRCCD/SMH - Various Utilites for generating the CCR/CCD;06/15/08 + ;;0.1;CCRCCD;;Jun 15, 2008; + + W "No Entry at Top!" Q + +FMDTOUTC(DATE) ; Convert Fileman Date to UTC Date Format; PUBLIC; Extrinsic + N UTC,Y,M,D ; UTC, Year, Month, Day + S Y=1700+$E(DATE,1,3) + S M=$E(DATE,4,5) + S D=$E(DATE,6,7) + S UTC=Y_"-"_M_"-"_D + Q UTC + ; Index: ccr/trunk/GPLCCD0.m =================================================================== --- ccr/trunk/GPLCCD0.m (revision 6) +++ ccr/trunk/GPLCCD0.m (revision 6) @@ -0,0 +1,226 @@ +GPLCCD0 ; CCDCCR/GPL - CCD TEMPLATE AND ACCESS ROUTINES; 6/7/08 + ;;0.1;CCDCCR;nopatch;noreleasedate + W "This is a CCD TEMPLATE with processing routines",! + W ! + Q + ; +ZT(ZARY,BAT,LINE) ; private routine to add a line to the ZARY array + ; ZARY IS PASSED BY NAME + ; BAT is a string identifying the section + ; LINE is a test which will evaluate to true or false + ; I '$G(@ZARY) D + . S @ZARY@(0)=0 ; initially there are no elements + . W "GOT HERE LOADING "_LINE,! + N CNT ; count of array elements + S CNT=@ZARY@(0) ; contains array count + S CNT=CNT+1 ; increment count + S @ZARY@(CNT)=LINE ; put the line in the array + ; S @ZARY@(BAT,CNT)="" ; index the test by battery + S @ZARY@(0)=CNT ; update the array counter + Q + ; +ZLOAD(ZARY,ROUTINE) ; load tests into ZARY which is passed by reference + ; ZARY IS PASSED BY NAME + ; ZARY = name of the root, closed array format (e.g., "^TMP($J)") + ; ROUTINE = NAME OF THE ROUTINE - PASSED BY VALUE + K @ZARY S @ZARY="" + S @ZARY@(0)=0 ; initialize array count + N LINE,LABEL,BODY + N INTEST S INTEST=0 ; switch for in the TEMPLATE section + N SECTION S SECTION="[anonymous]" ; NO section LABEL + ; + N NUM F NUM=1:1 S LINE=$T(+NUM^@ROUTINE) Q:LINE="" D + . I LINE?." "1";".E S INTEST=0 ; leaving section + . I INTEST D ; within the section + . . I LINE?." "1";><".E D ; sub-section name found + . . . S SECTION=$P($P(LINE,";><",2),">",1) ; pull out name + . . I LINE?." "1";;".E D ; line found + . . . D ZT(ZARY,SECTION,$P(LINE,";;",2)) ; put the line in the array + Q + ; +LOAD(ARY) ; LOAD A CCR TEMPLATE INTO ARY PASSED BY NAME + D ZLOAD(ARY,"GPLCCD0") + ; ZWR @ARY + Q + ; +; Index: ccr/trunk/GPLCCR.m =================================================================== --- ccr/trunk/GPLCCR.m (revision 6) +++ ccr/trunk/GPLCCR.m (revision 6) @@ -0,0 +1,93 @@ +GPLCCR ; CCDCCR/GPL - CCR MAIN PROCESSING; 6/6/08 + ;;0.1;CCDCCR;nopatch;noreleasedate + ; + ; EXPORT A CCR + ; +EXPORT ; EXPORT ENTRY POINT FOR CCR + ; would like to call fileman routine here to select a patient + S DIC=2,DIC(0)="AEMQ" D ^DIC + S DFN=$P(Y,U,1) ; SET THE PATIENT + N CCRGLO + D CCRRPC(.CCRGLO,DFN,"CCR") + S OARY=$NA(^TMP($J,DFN,"CCR",1)) + S ONAM="PAT_"_DFN_"_CCR_V1.xml" + S ODIR="/home/wvehr3/EHR/CCR" + D OUTPUT^GPLXPATH(OARY,ONAM,ODIR) + Q + ; +CCRRPC(CCRGRTN,DFN,CCRPART) ; RPC ENTRY POINT FOR CCR OUTPUT + S DEBUG=0 + S TGLOBAL=$NA(^TMP($J,"TEMPLATE")) ; GLOBAL FOR STORING TEMPLATE + S CCRGLO=$NA(^TMP($J,DFN,"CCR")) ; GLOBAL FOR BUILDING THE CCR + ; TO GET PART OF THE CCR RETURNED, PASS CCRPART="PROBLEMS" ETC + S CCRGRTN=$NA(^TMP($J,DFN,CCRPART)) ; RTN GLO NM OF PART OR ALL OF CCR + D LOAD^GPLCCR0(TGLOBAL) ; LOAD THE CCR TEMPLATE + D CP^GPLXPATH(TGLOBAL,CCRGLO) ; COPY THE TEMPLATE TO THE CCR GLOBAL + ; + ; DELETE THE BODY, ACTORS AND SIGNATURES SECTIONS FROM THE CCR GLOBAL + ; THESE WILL BE POPULATED WITH CALLS TO THE XPATH PROCESSING ROUTINES + D REPLACE^GPLXPATH(CCRGLO,"","//ContinuityOfCareRecord/Body") + D REPLACE^GPLXPATH(CCRGLO,"","//ContinuityOfCareRecord/Actors") + D REPLACE^GPLXPATH(CCRGLO,"","//ContinuityOfCareRecord/Signatures") + F I=1:1:@CCRGLO@(0) W @CCRGLO@(I),! + ; + S CCRXTAB="^TMP($J,""CCRSTEP"")" ; GLOBAL TO STORE CCR PROCESSING STEPS + D INITSTPS(CCRXTAB) ; INITIALIZED CCR PROCESSING STEPS + N I,XI,TAG,RTN,CALL,XPATH,IXML,OXML,INXML,CCRBLD + F I=1:1:@CCRXTAB@(0) D ; PROCESS THE CCR BODY SECTIONS + . S XI=@CCRXTAB@(I) ; CALL COPONENTS TO PARSE + . S RTN=$P(XI,";",2) ; NAME OF ROUTINE TO CALL + . S TAG=$P(XI,";",1) ; LABEL INSIDE ROUTINE TO CALL + . S XPATH=$P(XI,";",3) ; XPATH TO XML TO PASS TO ROUTINE + . D QUERY^GPLXPATH(TGLOBAL,XPATH,"INXML") ; EXTRACT XML TO PASS + . S IXML="INXML" + . S OXML=$P(XI,";",4) ; ARRAY FOR SECTION VALUES + . ; W OXML,! + . S CALL="D "_TAG_"^"_RTN_"(IXML,DFN,OXML)" ; SETUP THE CALL + . W "RUNNING ",CALL,! + . X CALL + . ; NOW INSERT THE RESULTS IN THE CCR BUFFER + . ; D INSERT^GPLXPATH(CCRGLO,OXML,"//ContinuityOfCareRecord/Body") + . I DEBUG F GPLI=1:1:@OXML@(0) W @OXML@(GPLI),! + . D QOPEN^GPLXPATH("CCRBLD",CCRGLO,"//ContinuityOfCareRecord/Body") + . D QUEUE^GPLXPATH("CCRBLD",OXML,1,@OXML@(0)) + . D QCLOSE^GPLXPATH("CCRBLD",CCRGLO,"//ContinuityOfCareRecord/Body") + . I DEBUG W "GOING TO BUILD CCR",! + . N CCRTMP + . D BUILD^GPLXPATH("CCRBLD","CCRTMP") + . I DEBUG F GPLI=1:1:CCRTMP(0) W CCRTMP(GPLI),! + . D CP^GPLXPATH("CCRTMP",CCRGLO) + Q + ; +INITSTPS(TAB) ; INITIALIZE CCR PROCESSING STEPS + ; TAB IS PASSED BY NAME + ; W "TAB= ",TAB,! + ; D PUSH^GPLXPATH(TAB,"EXTRACT;GPLVITALS;//ContinuityOfCareRecord/Body/VitalSigns;^TMP($J,DFN,""VITALS"")") + D PUSH^GPLXPATH(TAB,"EXTRACT;GPLPROBS;//ContinuityOfCareRecord/Body/Problems;^TMP($J,DFN,""PROBLEMS"")") + Q + ; +TEST ; RUN ALL THE TEST CASES + N ZTMP + D ZLOAD^GPLUNIT("ZTMP","GPLCCR") + D ZTEST^GPLUNIT(.ZTMP,"ALL") + W ! + ; W "THE TESTS!",! + ; ZWR ZTMP + Q + ; +ZTEST(WHICH) ; RUN ONE SET OF TESTS + N ZTMP + D ZLOAD^GPLUNIT("ZTMP","GPLCCR") + D ZTEST^GPLUNIT(.ZTMP,WHICH) + Q + ; +TLIST ; LIST THE TESTS + N ZTMP + D ZLOAD^GPLUNIT("ZTMP","GPLCCR") + D TLIST^GPLUNIT(.ZTMP) + Q + ; +;;> +;;> +;;>>>K GPL S GPL="" +;;> Index: ccr/trunk/GPLCCR0.m =================================================================== --- ccr/trunk/GPLCCR0.m (revision 6) +++ ccr/trunk/GPLCCR0.m (revision 6) @@ -0,0 +1,624 @@ +GPLCCR0 ; CCDCCR/GPL - CCR TEMPLATE AND ACCESS ROUTINES; 5/31/08 + ;;0.1;CCDCCR;nopatch;noreleasedate + W "This is a CCR TEMPLATE with processing routines",! + W ! + Q + ; +ZT(ZARY,BAT,LINE) ; private routine to add a line to the ZARY array + ; ZARY IS PASSED BY NAME + ; BAT is a string identifying the section + ; LINE is a test which will evaluate to true or false + ; I '$G(@ZARY) D + . S @ZARY@(0)=0 ; initially there are no elements + . W "GOT HERE LOADING "_LINE,! + N CNT ; count of array elements + S CNT=@ZARY@(0) ; contains array count + S CNT=CNT+1 ; increment count + S @ZARY@(CNT)=LINE ; put the line in the array + ; S @ZARY@(BAT,CNT)="" ; index the test by battery + S @ZARY@(0)=CNT ; update the array counter + Q + ; +ZLOAD(ZARY,ROUTINE) ; load tests into ZARY which is passed by reference + ; ZARY IS PASSED BY NAME + ; ZARY = name of the root, closed array format (e.g., "^TMP($J)") + ; ROUTINE = NAME OF THE ROUTINE - PASSED BY VALUE + K @ZARY S @ZARY="" + S @ZARY@(0)=0 ; initialize array count + N LINE,LABEL,BODY + N INTEST S INTEST=0 ; switch for in the TEMPLATE section + N SECTION S SECTION="[anonymous]" ; NO section LABEL + ; + N NUM F NUM=1:1 S LINE=$T(+NUM^@ROUTINE) Q:LINE="" D + . I LINE?." "1";".E S INTEST=0 ; leaving section + . I INTEST D ; within the section + . . I LINE?." "1";><".E D ; sub-section name found + . . . S SECTION=$P($P(LINE,";><",2),">",1) ; pull out name + . . I LINE?." "1";;".E D ; line found + . . . D ZT(ZARY,SECTION,$P(LINE,";;",2)) ; put the line in the array + Q + ; +LOAD(ARY) ; LOAD A CCR TEMPLATE INTO ARY PASSED BY NAME + D ZLOAD(ARY,"GPLCCR0") + ; ZWR @ARY + Q + ; +; Index: ccr/trunk/GPLPROBS.m =================================================================== --- ccr/trunk/GPLPROBS.m (revision 6) +++ ccr/trunk/GPLPROBS.m (revision 6) @@ -0,0 +1,63 @@ +GPLPROBS ; CCDCCR/GPL - CCR/CCD PROCESSING FOR PROBLEMS ; 6/6/08 + ;;0.1;CCDCCR;nopatch;noreleasedate + ; + ; PROCESS THE PROBLEMS SECTION OF THE CCR + ; +EXTRACT(IPXML,DFN,OUTXML) ; EXTRACT PROBLEMS INTO PROVIDED XML TEMPLATE + ; + ; INXML AND OUTXML ARE PASSED BY NAME SO GLOBALS CAN BE USED + ; INXML WILL CONTAIN ONLY THE PROBLEM SECTION OF THE OVERALL TEMPLATE + ; ONLY THE XML FOR ONE PROBLEM WILL BE PASSED. THIS ROUTINE WILL MAKE + ; COPIES AS NECESSARY TO REPRESENT MULTIPLE PROBLEMS + ; INSERT^GPLXPATH IS USED TO APPEND THE PROBLEMS TO THE OUTPUT + ; + N RPCRSLT,J,K,PTMP,X,VMAP,TBUF + D LIST^ORQQPL3(.RPCRSLT,DFN,"") ; CALL THE PROBLEM LIST RPC + I '$D(RPCRSLT(0)) W "ERROR CALLING LIST^ORQQPL3 ",! Q + I DEBUG ZWR RPCRSLT + S TVMAP=$NA(^TMP($J,"PROBVALS")) + S TARYTMP=$NA(^TMP($J,"PROBARYTMP")) + F J=1:1:RPCRSLT(0) D ; FOR EACH PROBLEM IN THE LIST + . S VMAP=$NA(@TVMAP@(J)) + . K @VMAP + . I DEBUG W "VMAP= ",VMAP,! + . S PTMP=RPCRSLT(J) ; PULL OUT PROBLEM FROM RPC RETURN ARRAY + . S @VMAP@("PROBLEMOBJECTID")="PROBLEM"_J ; UNIQUE OBJID FOR PROBLEM + . S @VMAP@("PROBLEMIEN")=$P(PTMP,U,1) + . S @VMAP@("PROBLEMSTATUS")=$P(PTMP,U,2) + . S @VMAP@("PROBLEMDESCRIPTION")=$P(PTMP,U,3) + . S @VMAP@("PROBLEMCODEVALUE")=$P(PTMP,U,4) + . S @VMAP@("PROBLEMDATEOFONSET")=$P(PTMP,U,5) + . S @VMAP@("PROBLEMDATEMOD")=$P(PTMP,U,6) + . S @VMAP@("PROBLEMSC")=$P(PTMP,U,7) + . S @VMAP@("PROBLEMSE")=$P(PTMP,U,8) + . S @VMAP@("PROBLEMCONDITION")=$P(PTMP,U,9) + . S @VMAP@("PROBLEMLOC")=$P(PTMP,U,10) + . S @VMAP@("PROBLEMLOCTYPE")=$P(PTMP,U,11) + . S @VMAP@("PROBLEMPROVIDER")=$P(PTMP,U,12) + . S X=@VMAP@("PROBLEMPROVIDER") ; FORMAT Y;NAME Y IS IEN OF PROVIDER + . S @VMAP@("PROBLEMSOURCEACTORID")="ACTORPROVIDER_"_$P(X,";",1) + . S @VMAP@("PROBLEMSERVICE")=$P(PTMP,U,13) + . S @VMAP@("PROBLEMHASCMT")=$P(PTMP,U,14) + . S @VMAP@("PROBLEMDTREC")=$P(PTMP,U,15) + . S @VMAP@("PROBLEMINACT")=$P(PTMP,U,16) + . S ARYTMP=$NA(@TARYTMP@(J)) + . ; W "ARYTMP= ",ARYTMP,! + . K @ARYTMP + . D MAP^GPLXPATH(IPXML,VMAP,ARYTMP) ; + . I J=1 D ; FIRST ONE IS JUST A COPY + . . ; W "FIRST ONE",! + . . D CP^GPLXPATH(ARYTMP,OUTXML) + . . ; W "OUTXML ",OUTXML,! + . I J>1 D ; AFTER THE FIRST, INSERT INNER XML + . . D INSINNER^GPLXPATH(OUTXML,ARYTMP) + ; ZWR ^TMP($J,"PROBVALS",*) + ; ZWR ^TMP($J,"PROBARYTMP",*) ; SHOW THE RESULTS + ; ZWR @OUTXML + ; $$HTML^DILF( + N PROBSTMP,I + D MISSING^GPLXPATH(ARYTMP,"PROBSTMP") ; SEARCH XML FOR MISSING VARS + I PROBSTMP(0)>0 D ; IF THERE ARE MISSING VARS - STRINGS MARKED AS @@X@@ + . W "PROBLEMS Missing list: ",! + . F I=1:1:PROBSTMP(0) W PROBSTMP(I),! + Q Index: ccr/trunk/GPLUNIT.m =================================================================== --- ccr/trunk/GPLUNIT.m (revision 6) +++ ccr/trunk/GPLUNIT.m (revision 6) @@ -0,0 +1,104 @@ +GPLUNIT ; CCDCCR/GPL - Unit Testing Library; 5/07/08 + ;;0.1;CCDCCR;nopatch;noreleasedate + W "This is a unit testing library",! + W ! + Q + ; +ZT(ZARY,BAT,TST) ; private routine to add a test case to the ZARY array + ; ZARY IS PASSED BY REFERENCE + ; BAT is a string identifying the test battery + ; TST is a test which will evaluate to true or false + ; I '$G(ZARY) D + ; . S ZARY(0)=0 ; initially there are no elements + ; W "GOT HERE LOADING "_TST,! + N CNT ; count of array elements + S CNT=ZARY(0) ; contains array count + S CNT=CNT+1 ; increment count + S ZARY(CNT)=TST ; put the test in the array + I $D(ZARY(BAT)) D ; NOT THE FIRST TEST IN BATTERY + . N II ; TEMP FOR ENDING TEST IN BATTERY + . S II=$P(ZARY(BAT),"^",2) + . S $P(ZARY(BAT),"^",2)=II+1 + I '$D(ZARY(BAT)) D ; FIRST TEST IN THIS BATTERY + . S ZARY(BAT)=CNT_"^"_CNT ; FIRST AND LAST TESTS IN BATTERY + . S ZARY("TESTS",BAT)="" ; PUT THE BATTERY IN THE TESTS INDEX + S ZARY(0)=CNT ; update the array counter + Q + ; +ZLOAD(ZARY,ROUTINE) ; load tests into ZARY which is passed by reference + ; ZARY IS PASSED BY NAME + ; ZARY = name of the root, closed array format (e.g., "^TMP($J)") + ; ROUTINE = NAME OF THE ROUTINE - PASSED BY VALUE + K @ZARY + S @ZARY@(0)=0 ; initialize array count + N LINE,LABEL,BODY + N INTEST S INTEST=0 ; switch for in the test case section + N SECTION S SECTION="[anonymous]" ; test case section + ; + N NUM F NUM=1:1 S LINE=$T(+NUM^@ROUTINE) Q:LINE="" D + . I LINE?." "1";;>".E S INTEST=1 ; entering test section + . I LINE?." "1";;>".E S INTEST=0 ; leaving TEMPLATE section + . I INTEST D ; within the testing section + . . I LINE?." "1";;><".E D ; section name found + . . . S SECTION=$P($P(LINE,";;><",2),">",1) ; pull out name + . . I LINE?." "1";;>>".E D ; test case found + . . . D ZT(.@ZARY,SECTION,$P(LINE,";;>>",2)) ; put the test in the array + S @ZARY@("ALL")="1"_"^"_@ZARY@(0) ; MAKE A BATTERY FOR ALL + Q + ; +ZTEST(ZARY,WHICH) ; try out the tests using a passed array ZTEST + N I,ZX,ZR,ZP + S DEBUG=0 + I '$D(ZARY(WHICH)) D ; TEST SECTION DOESN'T EXIST + . W "ERROR -- TEST SECTION DOESN'T EXIST -> ",WHICH,! + . Q ; EXIT + N FIRST,LAST + S FIRST=$P(ZARY(WHICH),"^",1) + S LAST=$P(ZARY(WHICH),"^",2) + F I=FIRST:1:LAST D + . I ZARY(I)?1">"1.E D ; NOT A TEST, JUST RUN THE STATEMENT + . . S ZP=$E(ZARY(I),2,$L(ZARY(I))) + . . ; W ZP,! + . . S ZX=ZP + . . W "RUNNING: "_ZP + . . X ZX + . . W "..SUCCESS: ",WHICH,! + . I ZARY(I)?1"?"1.E D ; THIS IS A TEST + . . S ZP=$E(ZARY(I),2,$L(ZARY(I))) + . . S ZX="S ZR="_ZP + . . W "TRYING: "_ZP + . . X ZX + . . W $S(ZR=1:"..PASSED ",1:"..FAILED "),! + . . I '$D(TPASSED) D ; NOT INITIALIZED YET + . . . S TPASSED=0 S TFAILED=0 + . . I ZR S TPASSED=TPASSED+1 + . . I 'ZR S TFAILED=TFAILED+1 + Q + ; +TEST ; RUN ALL THE TEST CASES + N ZTMP + D ZLOAD(.ZTMP) + D ZTEST(.ZTMP,"ALL") + W "PASSED: ",TPASSED,! + W "FAILED: ",TFAILED,! + W ! + W "THE TESTS!",! + ZWR ZTMP + Q + ; +TLIST(ZARY) ; LIST ALL THE TESTS + ; THEY ARE MARKED AS ;;> IN THE TEST CASES + ; ZARY IS PASSED BY REFERENCE + N I,J,K S I="" S I=$O(ZARY("TESTS",I)) + S K=1 + F J=0:0 Q:I="" D + . ; W "I IS NOW=",I,! + . W I," " + . S I=$O(ZARY("TESTS",I)) + . S K=K+1 I K=6 D + . . W ! + . . S K=1 + Q + ; Index: ccr/trunk/GPLVITALS.m =================================================================== --- ccr/trunk/GPLVITALS.m (revision 6) +++ ccr/trunk/GPLVITALS.m (revision 6) @@ -0,0 +1,15 @@ +GPLVITALS ; CCDCCR/GPL - CCR/CCD PROCESSING FOR VITALS ; 6/6/08 + ;;0.1;CCDCCR;nopatch;noreleasedate +EXTRACT(VITXML,DFN,OUTXML) ; EXTRACT PROBLEMS INTO PROVIDED XML TEMPLATE + ; + ; VITXML AND OUTXML ARE PASSED BY NAME SO GLOBALS CAN BE USED + ; IVITXML WILL CONTAIN ONLY THE VITALS SECTION OF THE OVERALL TEMPLATE + ; + N VITALSTMP,I + S VITALSTMP="^TMP($J,""MISSINGVITALS"")" + ; ZWR @VITXML + D MISSING^GPLXPATH(VITXML,VITALSTMP) ; SEARCH XML FOR MISSING VARS + I @VITALSTMP@(0)>0 D ; IF THERE ARE MISSING VARS - MARKED AS @@X@@ + . W "VITALS MISSING ",! + . F I=1:1:@VITALSTMP@(0) W @VITALSTMP@(I),! + Q Index: ccr/trunk/GPLXPATH.m =================================================================== --- ccr/trunk/GPLXPATH.m (revision 6) +++ ccr/trunk/GPLXPATH.m (revision 6) @@ -0,0 +1,517 @@ +GPLXPATH ; CCDCCR/GPL - XPATH XML manipulation utilities; 6/1/08 + ;;0.2;CCDCCR;nopatch;noreleasedate + W "This is an XML XPATH utility library",! + W ! + Q + ; +OUTPUT(OUTARY,OUTNAME,OUTDIR) ; WRITE AN ARRAY TO A FILE + ; + N Y + S Y=$$GTF^%ZISH(OUTARY,$QL(OUTARY),OUTDIR,OUTNAME) + I Y W "WROTE FILE: ",OUTNAME," TO ",OUTDIR,! + ; $NA(^TMP(14216,"FILE",0)),3,"/home/wvehr3","test.xml") + Q + ; +PUSH(STK,VAL) ; pushs VAL onto STK and updates STK(0) + ; VAL IS A STRING AND STK IS PASSED BY NAME + ; + I '$D(@STK@(0)) S @STK@(0)=0 ; IF THE ARRAY IS EMPTY, INITIALIZE + S @STK@(0)=@STK@(0)+1 ; INCREMENT ARRAY DEPTH + S @STK@(@STK@(0))=VAL ; PUT VAL A THE END OF THE ARRAY + Q + ; +POP(STK,VAL) ; POPS THE LAST VALUE OFF THE STK AND RETURNS IT IN VAL + ; VAL AND STK ARE PASSED BY REFERENCE + ; + I @STK@(0)<1 S VAL="",@STK@(0)=0 Q ; IF ARRAY IS EMPTY + I @STK@(0)>0 D + . S VAL=@STK@(@STK@(0)) + . K @STK@(@STK@(0)) + . S @STK@(0)=@STK@(0)-1 ; NEW DEPTH OF THE ARRAY + Q + ; +MKMDX(STK,RTN) ; MAKES A MUMPS INDEX FROM THE ARRAY STK + ; RTN IS SET TO //FIRST/SECOND/THIRD" FOR THREE ARRAY ELEMENTS + S RTN="" + N I + ; W "STK= ",STK,! + I @STK@(0)>0 D ; IF THE ARRAY IS NOT EMPTY + . S RTN="//"_@STK@(1) ; FIRST ELEMENT NEEDS NO SEMICOLON + . I @STK@(0)>1 D ; SUBSEQUENT ELEMENTS NEED A SEMICOLON + . . F I=2:1:@STK@(0) S RTN=RTN_"/"_@STK@(I) + Q + ; +XNAME(ISTR) ; FUNCTION TO EXTRACT A NAME FROM AN XML FRAG + ; AND WILL RETURN NAME + ; ISTR IS PASSED BY VALUE + N CUR,TMP + I ISTR?.E1"<".E D ; STRIP OFF LEFT BRACKET + . S TMP=$P(ISTR,"<",2) + I TMP?1"/".E D ; ALSO STRIP OFF SLASH IF PRESENT IE + . S TMP=$P(TMP,"/",2) + S CUR=$P(TMP,">",1) ; EXTRACT THE NAME + ; W "CUR= ",CUR,! + I CUR?.1"_"1.A1" ".E D ; CONTAINS A BLANK IE NAME ID=TEST> + . S CUR=$P(CUR," ",1) ; STRIP OUT BLANK AND AFTER + ; W "CUR2= ",CUR,! + Q CUR + ; +INDEX(ZXML) ; parse the XML in ZXML and produce an XPATH index + ; ex. ZXML(FIRST,SECOND,THIRD,FOURTH)=FIRSTLINE^LASTLINE + ; WHERE FIRSTLINE AND LASTLINE ARE THE BEGINNING AND ENDING OF THE + ; XML SECTION + ; ZXML IS PASSED BY NAME + N I,LINE,FIRST,LAST,CUR,TMP,MDX,FOUND + N GPLSTK ; LEAVE OUT FOR DEBUGGING + I '$D(@ZXML@(0)) D ; NO XML PASSED + . W "ERROR IN XML FILE",! + S GPLSTK(0)=0 ; INITIALIZE STACK + F I=1:1:@ZXML@(0) D ; PROCESS THE ENTIRE ARRAY + . S LINE=@ZXML@(I) + . ;W LINE,! + . S FOUND=0 ; INTIALIZED FOUND FLAG + . I LINE?.E1"".E) D + . . . ; THIS IS THE CASE THERE SECTION BEGINS AND ENDS ON THE SAME LINE + . . . ; W "FOUND ",LINE,! + . . . S FOUND=1 ; SET FOUND FLAG + . . . S CUR=$$XNAME(LINE) ; EXTRACT THE NAME + . . . D PUSH("GPLSTK",CUR) ; ADD TO THE STACK + . . . D MKMDX("GPLSTK",.MDX) ; GENERATE THE M INDEX + . . . ; W "MDX=",MDX,! + . . . I $D(@ZXML@(MDX)) D ; IN THE INDEX, IS A MULTIPLE + . . . . S $P(@ZXML@(MDX),"^",2)=I ; UPDATE LAST LINE NUMBER + . . . I '$D(@ZXML@(MDX)) D ; NOT IN THE INDEX, IS NOT A MULTIPLE + . . . . S @ZXML@(MDX)=I_"^"_I ; ADD INDEX ENTRY-FIRST AND LAST LINE + . . . D POP("GPLSTK",.TMP) ; REMOVE FROM STACK + . I FOUND'=1 D ; THE LINE DOESN'T CONTAIN THE START AND END OF A SEC + . . I LINE?.E1"") D ; BEGINNING OF A SECTION + . . . ; W "FOUND ",LINE,! + . . . S FOUND=1 ; SET FOUND FLAG + . . . S CUR=$$XNAME(LINE) ; EXTRACT THE NAME + . . . D PUSH("GPLSTK",CUR) ; ADD TO THE STACK + . . . D MKMDX("GPLSTK",.MDX) ; GENERATE THE M INDEX + . . . ; W "MDX=",MDX,! + . . . I $D(@ZXML@(MDX)) D ; IN THE INDEX, IS A MULTIPLE + . . . . S $P(@ZXML@(MDX),"^",2)=I ; UPDATE LAST LINE NUMBER + . . . I '$D(@ZXML@(MDX)) D ; NOT IN THE INDEX, IS NOT A MULTIPLE + . . . . S @ZXML@(MDX)=I_"^" ; INSERT INTO THE INDEX + S @ZXML@("INDEXED")="" + S @ZXML@("//")="1^"_@ZXML@(0) ; ROOT XPATH + Q + ; +QUERY(IARY,XPATH,OARY) ; RETURNS THE XML ARRAY MATCHING THE XPATH EXPRESSION + ; XPATH IS OF THE FORM "//FIRST/SECOND/THIRD" + ; IARY AND OARY ARE PASSED BY NAME + I '$D(@IARY@("INDEXED")) D ; INDEX IS NOT PRESENT IN IARY + . D INDEX(IARY) ; GENERATE AN INDEX FOR THE XML + N FIRST,LAST ; FIRST AND LAST LINES OF ARRAY TO RETURN + N TMP,I,J,QXPATH + S FIRST=1 + S LAST=@IARY@(0) ; FIRST AND LAST DEFAULT TO ROOT + I XPATH'="//" D ; NOT A ROOT QUERY + . S TMP=@IARY@(XPATH) ; LOOK UP LINE VALUES + . S FIRST=$P(TMP,"^",1) + . S LAST=$P(TMP,"^",2) + K @OARY + S @OARY@(0)=+LAST-FIRST+1 + S J=1 + FOR I=FIRST:1:LAST D + . S @OARY@(J)=@IARY@(I) ; COPY THE LINE TO OARY + . S J=J+1 + ; ZWR OARY + Q + ; +XF(IDX,XPATH) ; EXTRINSIC TO RETURN THE STARTING LINE FROM AN XPATH + ; INDEX WITH TWO PIECES START^FINISH + ; IDX IS PASSED BY NAME + Q $P(@IDX@(XPATH),"^",1) + ; +XL(IDX,XPATH) ; EXTRINSIC TO RETURN THE LAST LINE FROM AN XPATH + ; INDEX WITH TWO PIECES START^FINISH + ; IDX IS PASSED BY NAME + Q $P(@IDX@(XPATH),"^",2) + ; +START(ISTR) ; EXTRINSIC TO RETURN THE STARTING LINE FROM AN INDEX + ; TYPE STRING WITH THREE PIECES ARRAY;START;FINISH + ; COMPANION TO FINISH ; IDX IS PASSED BY NAME + Q $P(ISTR,";",2) + ; +FINISH(ISTR) ; EXTRINSIC TO RETURN THE LAST LINE FROM AN INDEX + ; TYPE STRING WITH THREE PIECES ARRAY;START;FINISH + Q $P(ISTR,";",3) + ; +ARRAY(ISTR) ; EXTRINSIC TO RETURN THE ARRAY REFERENCE FROM AN INDEX + ; TYPE STRING WITH THREE PIECES ARRAY;START;FINISH + Q $P(ISTR,";",1) + ; +BUILD(BLIST,BDEST) ; A COPY MACHINE THAT TAKE INSTRUCTIONS IN ARRAY BLIST + ; WHICH HAVE ARRAY;START;FINISH AND COPIES THEM TO DEST + ; DEST IS CLEARED TO START + ; USES PUSH TO DO THE COPY + N I + K @BDEST + F I=1:1:@BLIST@(0) D ; FOR EACH INSTRUCTION IN BLIST + . N J,ATMP + . S ATMP=$$ARRAY(@BLIST@(I)) + . I DEBUG W "ATMP=",ATMP,! + . I DEBUG W @BLIST@(I),! + . F J=$$START(@BLIST@(I)):1:$$FINISH(@BLIST@(I)) D ; + . . ; FOR EACH LINE IN THIS INSTR + . . I DEBUG W "BDEST= ",BDEST,! + . . I DEBUG W "ATMP= ",@ATMP@(J),! + . . D PUSH(BDEST,@ATMP@(J)) + Q + ; +QUEUE(BLST,ARRAY,FIRST,LAST) ; ADD AN ENTRY TO A BLIST + ; + I DEBUG W "QUEUEING ",BLST,! + D PUSH(BLST,ARRAY_";"_FIRST_";"_LAST) + Q + ; +CP(CPSRC,CPDEST) ; COPIES CPSRC TO CPDEST BOTH PASSED BY NAME + ; KILLS CPDEST FIRST + N CPINSTR + I DEBUG W "MADE IT TO COPY",CPSRC,CPDEST,! + I @CPSRC@(0)<1 D ; BAD LENGTH + . W "ERROR IN COPY BAD SOURCE LENGTH: ",CPSRC,! + . Q + D QUEUE("CPINSTR",CPSRC,1,@CPSRC@(0)) ; BLIST FOR ENTIRE ARRAY + D BUILD("CPINSTR",CPDEST) + Q + ; +QOPEN(QOBLIST,QOXML,QOXPATH) ; ADD ALL BUT THE LAST LINE OF QOXML TO QOBLIST + ; WARNING NEED TO DO QCLOSE FOR SAME XML BEFORE CALLING BUILD + ; QOXPATH IS OPTIONAL - IF PROVIDED, WILL OPEN INSIDE THE XPATH POINT + ; USED TO INSERT CHILDREN NODES + I @QOXML@(0)<1 D ; MALFORMED XML + . W "MALFORMED XML PASSED TO QOPEN: ",QOXML,! + . Q + I DEBUG W "DOING QOPEN",! + N S1,E1,QOT,QOTMP + S S1=1 ; OPEN FROM THE BEGINNING OF THE XML + I $D(QOXPATH) D ; XPATH PROVIDED + . D QUERY(QOXML,QOXPATH,"QOT") ; INSURE INDEX + . S E1=$P(@QOXML@(QOXPATH),"^",2)-1 + I '$D(QOXPATH) D ; NO XPATH PROVIDED, OPEN AT ROOT + . S E1=@QOXML@(0)-1 + D QUEUE(QOBLIST,QOXML,S1,E1) + ; S QOTMP=QOXML_"^"_S1_"^"_E1 + ; D PUSH(QOBLIST,QOTMP) + Q + ; +QCLOSE(QCBLIST,QCXML,QCXPATH) ; CLOSE XML AFTER A QOPEN + ; ADDS THE LIST LINE OF QCXML TO QCBLIST + ; USED TO FINISH INSERTING CHILDERN NODES + ; QCXPATH IS OPTIONAL - IF PROVIDED, WILL CLOSE UNTIL THE END + ; IF QOPEN WAS CALLED WITH XPATH, QCLOSE SHOULD BE TOO + I @QCXML@(0)<1 D ; MALFORMED XML + . W "MALFORMED XML PASSED TO QCLOSE: ",QCXML,! + I DEBUG W "GOING TO CLOSE",! + N S1,E1,QCT,QCTMP + S E1=@QCXML@(0) ; CLOSE UNTIL THE END OF THE XML + I $D(QCXPATH) D ; XPATH PROVIDED + . D QUERY(QCXML,QCXPATH,"QCT") ; INSURE INDEX + . S S1=$P(@QCXML@(QCXPATH),"^",2) ; REMAINING XML + I '$D(QCXPATH) D ; NO XPATH PROVIDED, CLOSE AT ROOT + . S S1=@QCXML@(0) + D QUEUE(QCBLIST,QCXML,S1,E1) + ; D PUSH(QCBLIST,QCXML_";"_S1_";"_E1) + Q + ; +INSERT(INSXML,INSNEW,INSXPATH) ; INSERT INSNEW INTO INSXML AT THE + ; INSXPATH XPATH POINT INSXPATH IS OPTIONAL - IF IT IS + ; OMITTED, INSERTION WILL BE AT THE ROOT + ; NOTE INSERT IS NON DESTRUCTIVE AND WILL ADD THE NEW + ; XML AT THE END OF THE XPATH POINT + ; INSXML AND INSNEW ARE PASSED BY NAME INSXPATH IS A VALUE + ; N INSBLD,INSTMP + I DEBUG W "DOING INSERT ",INSXML,INSNEW,INSXPATH,! + I DEBUG F G1=1:1:@INSXML@(0) W @INSXML@(G1),! + I '$D(@INSXML@(0)) D ; INSERT INTO AN EMPTY ARRAY + . W "DOING A BAD COPY",! + . D CP^GPLXPATH(INSNEW,INXML) ; JUST COPY INTO THE OUTPUT + I $D(@INSXML@(0)) D ; IF ORIGINAL ARRAY IS NOT EMPTY + . W "GOT HERE",! + . I $D(INSXPATH) D ; XPATH PROVIDED + . . D QOPEN("INSBLD",INSXML,INSXPATH) ; COPY THE BEFORE + . . I DEBUG ZWR INSBLD + . I '$D(INSXPATH) D ; NO XPATH PROVIDED, OPEN AT ROOT + . . D QOPEN("INSBLD",INSXML,"//") ; OPEN WITH ROOT XPATH + . D QUEUE("INSBLD",INSNEW,1,@INSNEW@(0)) ; COPY IN NEW XML + . I $D(INSXPATH) D ; XPATH PROVIDED + . . D QCLOSE("INSBLD",INSXML,INSXPATH) ; CLOSE WITH XPATH + . I '$D(INSXPATH) D ; NO XPATH PROVIDED, CLOSE AT ROOT + . . D QCLOSE("INSBLD",INSXML,"//") ; CLOSE WITH ROOT XPATH + . D BUILD("INSBLD",INSTMP) ; PUT RESULTS IN INDEST + . D CP^GPLXPATH(INSTMP,INSXML) ; COPY BUFFER TO SOURCE + Q + ; +INSINNER(INNXML,INNNEW,INNXPATH) ; INSERT THE INNER XML OF INNNEW + ; INTO INNXML AT THE INNXPATH XPATH POINT + ; + N INNBLD,UXPATH + N INNTBUF + S INNTBUF=$NA(^TMP($J,"INNTBUF")) + I '$D(INNXPATH) D ; XPATH NOT PASSED + . S UXPATH="//" ; USE ROOT XPATH + I $D(INNXPATH) S UXPATH=INNXPATH ; USE THE XPATH THAT'S PASSED + I '$D(@INNXML@(0)) D ; INNXML IS EMPTY + . D QUEUE^GPLXPATH("INNBLD",INNNEW,2,@INNNEW@(0)-1) ; JUST INNER XML + . D BUILD("INNBLD",INNXML) + I @INNXML@(0)>0 D ; NOT EMPTY + . D QOPEN("INNBLD",INNXML,UXPATH) ; + . D QUEUE("INNBLD",INNNEW,2,@INNNEW@(0)-1) ; JUST INNER XML + . D QCLOSE("INNBLD",INNXML,UXPATH) + . D BUILD("INNBLD",INNTBUF) ; BUILD TO BUFFER + . D CP(INNTBUF,INNXML) ; COPY BUFFER TO DEST + Q + ; +REPLACE(REXML,RENEW,REXPATH) ; REPLACE THE XML AT THE XPATH POINT + ; WITH RENEW - NOTE THIS WILL DELETE WHAT WAS THERE BEFORE + ; REXML AND RENEW ARE PASSED BY NAME XPATH IS A VALUE + ; THE DELETED XML IS PUT IN ^TMP($J,"REPLACE_OLD") + N REBLD,XFIRST,XLAST,OLD,XNODE,RETMP + S OLD=$NA(^TMP($J,"REPLACE_OLD")) + D QUERY(REXML,REXPATH,OLD) ; CREATE INDEX, TEST XPATH, MAKE OLD + S XNODE=@REXML@(REXPATH) ; PULL OUT FIRST AND LAST LINE PTRS + S XFIRST=$P(XNODE,"^",1) + S XLAST=$P(XNODE,"^",2) + D QUEUE("REBLD",REXML,1,XFIRST) ; THE BEFORE + I RENEW'="" D ; NEW XML IS NOT NULL + . D QUEUE("REBLD",RENEW,1,@RENEW@(0)) ; THE NEW + D QUEUE("REBLD",REXML,XLAST,@REXML@(0)) ; THE REST + I DEBUG W "REPALCE PREBUILD",! + I DEBUG ZWR REBLD + D BUILD("REBLD","RTMP") + K @REXML ; KILL WHAT WAS THERE + D CP("RTMP",REXML) ; COPY IN THE RESULT + Q + ; +MISSING(IXML,OARY) ; SEARTH THROUGH INXLM AND PUT ANY @@X@@ VARS IN OARY + ; W "Reporting on the missing",! + ; W OARY + I '$D(@IXML@(0)) W "MALFORMED XML PASSED TO MISSING",! Q + N I + S @OARY@(0)=0 ; INITIALIZED MISSING COUNT + F I=1:1:@IXML@(0) D ; LOOP THROUGH WHOLE ARRAY + . I @IXML@(I)?.E1"@@".E D ; MISSING VARIABLE HERE + . . D PUSH^GPLXPATH(OARY,$P(@IXML@(I),"@@",2)) ; ADD TO OUTARY + . . Q + Q + ; +MAP(IXML,INARY,OXML) ; SUBSTITUTE @@X@@ VARS IN IXML WITH VALUES IN INARY + ; AND PUT THE RESULTS IN OXML + I '$D(@IXML@(0)) W "MALFORMED XML PASSED TO MAP",! Q + I $O(@INARY@(""))="" W "EMPTY ARRAY PASSED TO MAP",! Q + N I,TNAM,TVAL + S @OXML@(0)=@IXML@(0) ; TOTAL LINES IN OUTPUT + F I=1:1:@OXML@(0) D ; LOOP THROUGH WHOLE ARRAY + . S @OXML@(I)=@IXML@(I) ; COPY THE LINE TO OUTPUT + . I @OXML@(I)?.E1"@@".E D ; IS THERE A VARIABLE HERE? + . . S TNAM=$P(@OXML@(I),"@@",2) ; EXTRACT THE VARIABLE NAME + . . I $D(@INARY@(TNAM)) D ; IS THE VARIABLE IN THE MAP? + . . . S TVAL=@INARY@(TNAM) ; PULL OUT MAPPED VALUE + . . . S @OXML@(I)=$P(@OXML@(I),"@@",1)_TVAL_$P(@OXML@(I),"@@",3) ;MAPIT + W "MAPPED",! + Q + ; +PARY(GLO) ;PRINT AN ARRAY + N I + F I=1:1:@GLO@(0) W @GLO@(I),! + Q + ; +TEST ; RUN ALL THE TEST CASES + N ZTMP + D ZLOAD^GPLUNIT("ZTMP","GPLXPATH") + D ZTEST^GPLUNIT(.ZTMP,"ALL") + W "PASSED: ",TPASSED,! + W "FAILED: ",TFAILED,! + W ! + ; W "THE TESTS!",! + ; ZWR ZTMP + Q + ; +ZTEST(WHICH) ; RUN ONE SET OF TESTS + N ZTMP + D ZLOAD^GPLUNIT("ZTMP","GPLXPATH") + D ZTEST^GPLUNIT(.ZTMP,WHICH) + Q + ; +TLIST ; LIST THE TESTS + N ZTMP + D ZLOAD^GPLUNIT("ZTMP","GPLXPATH") + D TLIST^GPLUNIT(.ZTMP) + Q + ; +;;> +;;> +;;>>>K GPL S GPL="" +;;>>>D PUSH^GPLXPATH("GPL","FIRST") +;;>>>D PUSH^GPLXPATH("GPL","SECOND") +;;>>>D PUSH^GPLXPATH("GPL","THIRD") +;;>>>D PUSH^GPLXPATH("GPL","FOURTH") +;;>>?GPL(0)=4 +;;> +;;>>>K GXML S GXML="" +;;>>>D PUSH^GPLXPATH("GXML","") +;;>>>D PUSH^GPLXPATH("GXML","") +;;>>>D PUSH^GPLXPATH("GXML","") +;;>>>D PUSH^GPLXPATH("GXML","@@DATA1@@") +;;>>>D PUSH^GPLXPATH("GXML","") +;;>>>D PUSH^GPLXPATH("GXML","@@DATA2@@") +;;>>>D PUSH^GPLXPATH("GXML","") +;;>>>D PUSH^GPLXPATH("GXML","") +;;>>>D PUSH^GPLXPATH("GXML","") +;;>>>D PUSH^GPLXPATH("GXML","") +;;>>>D PUSH^GPLXPATH("GXML","") +;;>>>D PUSH^GPLXPATH("GXML","") +;;>>>D PUSH^GPLXPATH("GXML","") +;;> +;;>>>K GXML S GXML="" +;;>>>D PUSH^GPLXPATH("GXML","") +;;>>>D PUSH^GPLXPATH("GXML","") +;;>>>D PUSH^GPLXPATH("GXML","") +;;>>>D PUSH^GPLXPATH("GXML","DATA1") +;;>>>D PUSH^GPLXPATH("GXML","") +;;>>>D PUSH^GPLXPATH("GXML","DATA2") +;;>>>D PUSH^GPLXPATH("GXML","") +;;>>>D PUSH^GPLXPATH("GXML","") +;;>>>D PUSH^GPLXPATH("GXML","<_SECOND>") +;;>>>D PUSH^GPLXPATH("GXML","DATA3") +;;>>>D PUSH^GPLXPATH("GXML","") +;;>>>D PUSH^GPLXPATH("GXML","") +;;>>>D PUSH^GPLXPATH("GXML","") +;;> +;;>>>D ZLOAD^GPLUNIT("ZTMP","GPLXPATH") +;;>>>D ZTEST^GPLUNIT(.ZTMP,"INIT") +;;>>?GPL(GPL(0))="FOURTH" +;;>>>D POP^GPLXPATH("GPL",.GX) +;;>>?GX="FOURTH" +;;>>?GPL(GPL(0))="THIRD" +;;>>>D POP^GPLXPATH("GPL",.GX) +;;>>?GX="THIRD" +;;>>?GPL(GPL(0))="SECOND" +;;> +;;>>>D ZLOAD^GPLUNIT("ZTMP","GPLXPATH") +;;>>>D ZTEST^GPLUNIT(.ZTMP,"INIT") +;;>>>S GX="" +;;>>>D MKMDX^GPLXPATH("GPL",.GX) +;;>>?GX="//FIRST/SECOND/THIRD/FOURTH" +;;> +;;>>?$$XNAME^GPLXPATH("DATA1")="FOURTH" +;;>>?$$XNAME^GPLXPATH("")="SIXTH" +;;>>?$$XNAME^GPLXPATH("")="THIRD" +;;> +;;>>>D ZLOAD^GPLUNIT("ZTMP","GPLXPATH") +;;>>>D ZTEST^GPLUNIT(.ZTMP,"INITXML") +;;>>>D INDEX^GPLXPATH("GXML") +;;>>?GXML("//FIRST/SECOND")="2^12" +;;>>?GXML("//FIRST/SECOND/THIRD")="3^9" +;;>>?GXML("//FIRST/SECOND/THIRD/FIFTH")="5^7" +;;>>?GXML("//FIRST/SECOND/THIRD/FOURTH")="4^4" +;;>>?GXML("//FIRST/SECOND/THIRD/SIXTH")="8^8" +;;>>?GXML("//FIRST/SECOND")="2^12" +;;>>?GXML("//FIRST")="1^13" +;;> +;;>>>D ZTEST^GPLXPATH("INITXML2") +;;>>>D INDEX^GPLXPATH("GXML") +;;>>?GXML("//FIRST/SECOND")="2^12" +;;>>?GXML("//FIRST/SECOND/_SECOND")="9^11" +;;>>?GXML("//FIRST/SECOND/_SECOND/FOURTH")="10^10" +;;>>?GXML("//FIRST/SECOND/THIRD")="3^8" +;;>>?GXML("//FIRST/SECOND/THIRD/FOURTH")="4^7" +;;>>?GXML("//FIRST")="1^13" +;;> +;;>>>D ZTEST^GPLXPATH("INITXML") +;;>>>S OUTARY="^TMP($J,""MISSINGTEST"")" +;;>>>D MISSING^GPLXPATH("GXML",OUTARY) +;;>>?@OUTARY@(1)="DATA1" +;;>>?@OUTARY@(2)="DATA2" +;;> +;;>>>D ZTEST^GPLXPATH("INITXML") +;;>>>S MAPARY="^TMP($J,""MAPVALUES"")" +;;>>>S OUTARY="^TMP($J,""MAPTEST"")" +;;>>>S @MAPARY@("DATA2")="VALUE2" +;;>>>D MAP^GPLXPATH("GXML",MAPARY,OUTARY) +;;>>?@OUTARY@(6)="VALUE2" +;;> +;;>>>D QUEUE^GPLXPATH("BTLIST","GXML",2,3) +;;>>>D QUEUE^GPLXPATH("BTLIST","GXML",4,5) +;;>>?$P(BTLIST(2),";",2)=4 +;;> +;;>>>D ZTEST^GPLXPATH("INITXML") +;;>>>D QUERY^GPLXPATH("GXML","//FIRST/SECOND/THIRD/FOURTH","G2") +;;>>>D ZTEST^GPLXPATH("QUEUE") +;;>>>D BUILD^GPLXPATH("BTLIST","G3") +;;> +;;>>>D ZTEST^GPLXPATH("INITXML") +;;>>>D CP^GPLXPATH("GXML","G2") +;;>>?G2(0)=13 +;;> +;;>>>K G2,GBL +;;>>>D ZTEST^GPLXPATH("INITXML") +;;>>>D QOPEN^GPLXPATH("GBL","GXML") +;;>>?$P(GBL(1),"^",3)=12 +;;>>>D BUILD^GPLXPATH("GBL","G2") +;;>>?G2(G2(0))="" +;;> +;;>>>K G2,GBL +;;>>>D ZTEST^GPLXPATH("INITXML") +;;>>>D QOPEN^GPLXPATH("GBL","GXML","//FIRST/SECOND") +;;>>?$P(GBL(1),"^",3)=12 +;;>>>D BUILD^GPLXPATH("GBL","G2") +;;>>?G2(G2(0))="" +;;> +;;>>>K G2,GBL +;;>>>D ZTEST^GPLXPATH("INITXML") +;;>>>D QCLOSE^GPLXPATH("GBL","GXML") +;;>>?$P(GBL(1),"^",3)=13 +;;>>>D BUILD^GPLXPATH("GBL","G2") +;;>>?G2(G2(0))="" +;;> +;;>>>K G2,GBL +;;>>>D ZTEST^GPLXPATH("INITXML") +;;>>>D QCLOSE^GPLXPATH("GBL","GXML","//FIRST/SECOND/THIRD") +;;>>?$P(GBL(1),"^",3)=13 +;;>>>D BUILD^GPLXPATH("GBL","G2") +;;>>?G2(G2(0))="" +;;>>?G2(1)="" +;;> +;;>>>K G2,GBL,G3,G4 +;;>>>D ZTEST^GPLXPATH("INITXML") +;;>>>D QUERY^GPLXPATH("GXML","//FIRST/SECOND/THIRD/FIFTH","G2") +;;>>>D INSERT^GPLXPATH("GXML","G2","G3","//FIRST/SECOND/THIRD") +;;>>>D INSERT^GPLXPATH("G3","G2","G4","//FIRST/SECOND/THIRD") +;;>>?G2(1)=G3(9) +;;> +;;>>>K G2,GBL,G3 +;;>>>D ZTEST^GPLXPATH("INITXML") +;;>>>D QUERY^GPLXPATH("GXML","//FIRST/SECOND/THIRD/FIFTH","G2") +;;>>>D REPLACE^GPLXPATH("GXML","G2","//FIRST/SECOND") +;;>>?GXML(3)="" +;;> +;;>>>K GXML,G2,GBL,G3 +;;>>>D ZTEST^GPLXPATH("INITXML") +;;>>>D QUERY^GPLXPATH("GXML","//FIRST/SECOND/THIRD","G2") +;;>>>D INSINNER^GPLXPATH("GXML","G2","//FIRST/SECOND/THIRD") +;;>>?GXML(10)="" +;;> +;;>>>K GXML,G2,GBL,G3 +;;>>>D ZTEST^GPLXPATH("INITXML") +;;>>>D QUERY^GPLXPATH("GXML","//FIRST/SECOND/THIRD","G2") +;;>>>D INSINNER^GPLXPATH("G2","G2") +;;>>?G2(8)="" +;;> Index: ccr/trunk/ZGPLCCR0.m =================================================================== --- ccr/trunk/ZGPLCCR0.m (revision 6) +++ ccr/trunk/ZGPLCCR0.m (revision 6) @@ -0,0 +1,640 @@ +ZGPLCCR0 ; CCDCCR/GPL - CCR TEMPLATE AND ACCESS ROUTINES; 5/31/08 + ;;0.1;CCDCCR;nopatch;noreleasedate + W "This is a CCR TEMPLATE with processing routines",! + W ! + Q + ; +ZT(ZARY,BAT,LINE) ; private routine to add a line to the ZARY array + ; ZARY IS PASSED BY NAME + ; BAT is a string identifying the section + ; LINE is a test which will evaluate to true or false + ; I '$G(@ZARY) D + . S @ZARY@(0)=0 ; initially there are no elements + . W "GOT HERE LOADING "_LINE,! + N CNT ; count of array elements + S CNT=@ZARY@(0) ; contains array count + S CNT=CNT+1 ; increment count + S @ZARY@(CNT)=LINE ; put the line in the array + ; S @ZARY@(BAT,CNT)="" ; index the test by battery + S @ZARY@(0)=CNT ; update the array counter + Q + ; +ZLOAD(ZARY,ROUTINE) ; load tests into ZARY which is passed by reference + ; ZARY IS PASSED BY NAME + ; ZARY = name of the root, closed array format (e.g., "^TMP($J)") + ; ROUTINE = NAME OF THE ROUTINE - PASSED BY VALUE + K @ZARY S @ZARY="" + S @ZARY@(0)=0 ; initialize array count + N LINE,LABEL,BODY + N INTEST S INTEST=0 ; switch for in the TEMPLATE section + N SECTION S SECTION="[anonymous]" ; NO section LABEL + ; + N NUM F NUM=1:1 S LINE=$T(+NUM^@ROUTINE) Q:LINE="" D + . I LINE?." "1";".E S INTEST=0 ; leaving section + . I INTEST D ; within the section + . . I LINE?." "1";><".E D ; sub-section name found + . . . S SECTION=$P($P(LINE,";><",2),">",1) ; pull out name + . . I LINE?." "1";;".E D ; line found + . . . D ZT(ZARY,SECTION,$P(LINE,";;",2)) ; put the line in the array + Q + ; +LOAD(ARY) ; LOAD A CCR TEMPLATE INTO ARY PASSED BY NAME + D ZLOAD(ARY,"ZGPLCCR0") + ; ZWR @ARY + Q + ; +;