From fd18bd0cd34581c17215dc3e9c0ee89b987d27a6 Mon Sep 17 00:00:00 2001 From: sam Date: Wed, 25 Jun 2008 01:42:13 +0000 Subject: [PATCH] Fixing more of the mess. --- CCRDPT.m | 133 ----------- CCRUTIL.m | 13 -- GPLCCD0.m | 226 ------------------- GPLCCR.m | 93 -------- GPLCCR0.m | 624 -------------------------------------------------- GPLPROBS.m | 63 ------ GPLUNIT.m | 104 --------- GPLVITALS.m | 15 -- GPLXPATH.m | 517 ------------------------------------------ ZGPLCCR0.m | 640 ---------------------------------------------------- 10 files changed, 2428 deletions(-) delete mode 100644 CCRDPT.m delete mode 100644 CCRUTIL.m delete mode 100644 GPLCCD0.m delete mode 100644 GPLCCR.m delete mode 100644 GPLCCR0.m delete mode 100644 GPLPROBS.m delete mode 100644 GPLUNIT.m delete mode 100644 GPLVITALS.m delete mode 100644 GPLXPATH.m delete mode 100644 ZGPLCCR0.m diff --git a/CCRDPT.m b/CCRDPT.m deleted file mode 100644 index 4c14d39..0000000 --- a/CCRDPT.m +++ /dev/null @@ -1,133 +0,0 @@ -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) - ; diff --git a/CCRUTIL.m b/CCRUTIL.m deleted file mode 100644 index 4373c70..0000000 --- a/CCRUTIL.m +++ /dev/null @@ -1,13 +0,0 @@ -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 - ; diff --git a/GPLCCD0.m b/GPLCCD0.m deleted file mode 100644 index 736352e..0000000 --- a/GPLCCD0.m +++ /dev/null @@ -1,226 +0,0 @@ -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 - ; -; diff --git a/GPLCCR.m b/GPLCCR.m deleted file mode 100644 index 6852d38..0000000 --- a/GPLCCR.m +++ /dev/null @@ -1,93 +0,0 @@ -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="" -;;> diff --git a/GPLCCR0.m b/GPLCCR0.m deleted file mode 100644 index b6d36a9..0000000 --- a/GPLCCR0.m +++ /dev/null @@ -1,624 +0,0 @@ -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 - ; -; diff --git a/GPLPROBS.m b/GPLPROBS.m deleted file mode 100644 index 5d85b35..0000000 --- a/GPLPROBS.m +++ /dev/null @@ -1,63 +0,0 @@ -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 diff --git a/GPLUNIT.m b/GPLUNIT.m deleted file mode 100644 index 02911c4..0000000 --- a/GPLUNIT.m +++ /dev/null @@ -1,104 +0,0 @@ -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 - ; diff --git a/GPLVITALS.m b/GPLVITALS.m deleted file mode 100644 index 4bbbaca..0000000 --- a/GPLVITALS.m +++ /dev/null @@ -1,15 +0,0 @@ -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 \ No newline at end of file diff --git a/GPLXPATH.m b/GPLXPATH.m deleted file mode 100644 index c70e100..0000000 --- a/GPLXPATH.m +++ /dev/null @@ -1,517 +0,0 @@ -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)="" -;;> diff --git a/ZGPLCCR0.m b/ZGPLCCR0.m deleted file mode 100644 index 056c142..0000000 --- a/ZGPLCCR0.m +++ /dev/null @@ -1,640 +0,0 @@ -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 - ; -;