Index: ccr/trunk/p/CCRDPT.m =================================================================== --- ccr/trunk/p/CCRDPT.m (revision 174) +++ ccr/trunk/p/CCRDPT.m (revision 175) @@ -1,556 +1,270 @@ -CCRDPT ;CCRCCD/SMH - Routines to Extract Patient Data for CCDCCR; 6/15/08 - ;;0.1;CCRCCD;;Jun 15, 2008; - ;Copyright 2008 WorldVistA. Licensed under the terms of the GNU - ;General Public License See attached copy of the License. - ; - ;This program is free software; you can redistribute it and/or modify - ;it under the terms of the GNU General Public License as published by - ;the Free Software Foundation; either version 2 of the License, or - ;(at your option) any later version. - ; - ;This program is distributed in the hope that it will be useful, - ;but WITHOUT ANY WARRANTY; without even the implied warranty of - ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - ;GNU General Public License for more details. - ; - ;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. - ; NOTE TO PROGRAMMER: You need to call INIT(DPT) to initialize; and - ; DESTROY to clean-up. - ; The first line of every routine tests if the global exists. - ; - ; CCRDPT 83 lines CCRCCD/SMH - Routines to Extract Patient Data for - ; INIT 9 lines Copy DFN global to a local variable - ; DESTROY 6 lines Kill local variable - ; FAMILY 6 lines Family Name - ; GIVEN 6 lines Given Name - ; MIDDLE 6 lines Middle Name - ; SUFFIX 6 lines Suffix Name - ; DISPNAME 5 lines Display Name - ; DOB 6 lines Date of Birth - ; GENDER 4 lines Get Gender - ; SSN 4 lines Get SSN for ID - ; ADDRTYPE 4 lines Get Home Address - ; ADDR1 4 lines Get Home Address line 1 - ; ADDR2 5 lines Get Home Address line 2 - ; CITY 4 lines Get City for Home Address - ; STATE 11 lines Get State for Home Address - ; ZIP 4 lines Get Zip code for Home Address - ; COUNTY 4 lines Get County for our Address - ; COUNTRY 4 lines Get Country for our Address - ; RESTEL 4 lines Residential Telephone - ; WORKTEL 4 lines Work Telephone - ; EMAIL 4 lines Email Adddress - ; CELLTEL 4 lines Cell Phone - ; NOK1FAM 6 lines Next of Kin 1 (NOK1) Family Name - ; NOK1GIV 6 lines NOK1 Given Name - ; NOK1MID 6 lines NOK1 Middle Name - ; NOK1SUF 6 lines NOK1 Suffi Name - ; NOK1DISP 5 lines NOK1 Display Name - ; NOK1REL 4 lines NOK1 Relationship to the patient - ; NOK1ADD1 4 lines NOK1 Address 1 - ; NOK1ADD2 5 lines NOK1 Address 2 - ; NOK1CITY 4 lines NOK1 City - ; NOK1STAT 5 lines NOK1 State - ; NOK1ZIP 4 lines NOK1 Zip Code - ; NOK1HTEL; 4 lines NOK1 Home Telephone - ; NOK1WTEL; 4 lines NOK1 Work Telephone - ; NOK1SAME; 4 lines Is NOK1's Address the same the patient? - ; NOK2FAM 6 lines NOK2 Family Name - ; NOK2GIV 6 lines NOK2 Given Name - ; NOK2MID 6 lines NOK2 Middle Name - ; NOK2SUF 5 lines NOK2 Suffi Name - ; NOK2DISP 5 lines NOK2 Display Name - ; NOK2REL 4 lines NOK2 Relationship to the patient - ; NOK2ADD1 4 lines NOK2 Address 1 - ; NOK2ADD2 5 lines NOK2 Address 2 - ; NOK2CITY 4 lines NOK2 City - ; NOK2STAT 5 lines NOK2 State - ; NOK2ZIP 4 lines NOK2 Zip Code - ; NOK2HTEL; 4 lines NOK2 Home Telephone - ; NOK2WTEL; 4 lines NOK2 Work Telephone - ; NOK2SAME; 4 lines Is NOK2's Address the same the patient? - ; EMERFAM 6 lines Emergency Contact (EMER) Family Name - ; EMERGIV 6 lines EMER Given Name - ; EMERMID 6 lines EMER Middle Name - ; EMERSUF 5 lines EMER Suffi Name - ; EMERDISP 5 lines EMER Display Name - ; EMERREL 4 lines EMER Relationship to the patient - ; EMERADD1 4 lines EMER Address 1 - ; EMERADD2 5 lines EMER Address 2 - ; EMERCITY 4 lines EMER City - ; EMERSTAT 5 lines EMER State - ; EMERZIP 4 lines EMER Zip Code - ; EMERHTEL; 4 lines EMER Home Telephone - ; EMERWTEL; 4 lines EMER Work Telephone - ; EMERSAME; 4 lines Is EMER's Address the same the NOK? - ; - 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] ^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. -INIT(DFN) ; - 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 - Q:$G(PT(0))="" "" - N NAME S NAME=$P(PT(0),"^",1) - D NAMECOMP^XLFNAME(.NAME) - Q NAME("FAMILY") - ; -GIVEN() ; Given Name; PUBLIC; Extrinsic - ; PREREQ: PT Defined - Q:$G(PT(0))="" "" - N NAME S NAME=$P(PT(0),"^",1) - D NAMECOMP^XLFNAME(.NAME) - Q NAME("GIVEN") - ; -MIDDLE() ; Middle Name; PUBLIC; Extrinsic - ; PREREQ: PT Defined - Q:$G(PT(0))="" "" - N NAME S NAME=$P(PT(0),"^",1) - D NAMECOMP^XLFNAME(.NAME) - Q NAME("MIDDLE") - ; -SUFFIX() ; Suffi Name; PUBLIC; Extrinsic - ; PREREQ: PT Defined - Q:$G(PT(0))="" "" - N NAME S NAME=$P(PT(0),"^",1) - D NAMECOMP^XLFNAME(.NAME) - Q NAME("SUFFIX") - ; -DISPNAME() ; Display Name; PUBLIC; Extrinsic - ; PREREQ: PT Defined - Q:$G(PT(0))="" "" - 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 - Q:$G(PT(0))="" "" - N DOB S DOB=$P(PT(0),"^",3) - ; Date in FM Date Format. Convert to UTC/ISO 8601. - Q $$FMDTOUTC^CCRUTIL(DOB,"D") - ; -GENDER() ; Get Gender; PUBLIC; Extrinsic - ; PREREQ: PT Defined - Q:$G(PT(0))="" "" - Q $P(PT(0),"^",2) - ; -SSN() ; Get SSN for ID; PUBLIC; Extrinsic - ; PREREQ: PT Defined - Q:$G(PT(0))="" "" - Q $P(PT(0),"^",9) - ; -ADDRTYPE() ; Get Home Address; PUBLIC; Extrinsic - ; Vista only stores a home address for the patient. - Q:$G(PT(0))="" "" - Q "Home" - ; -ADDR1() ; Get Home Address line 1; PUBLIC; Extrinsic - ; PREREQ: PT Defined - Q:$G(PT(.11))="" "" - Q $P(PT(.11),"^",1) - ; -ADDR2() ; Get Home Address line 2; PUBLIC; Extrinsic - ; PREREQ: PT Defined - ; Vista has Lines 2,3; CCR has only line 1,2; so compromise - Q:$G(PT(.11))="" "" - ; If the thrid address is empty, just return the 2nd. - ; If the 2nd is empty, we don't lose, b/c it will return "" - ; This is so that we won't produce a comma if there is no 3rd addr. - Q:$P(PT(.11),"^",3)="" $P(PT(.11),"^",2) - Q $P(PT(.11),"^",2)_", "_$P(PT(.11),"^",3) - ; -CITY() ; Get City for Home Address; PUBLIC; Extrinsic - ; PREREQ: PT Defined - Q:$G(PT(.11))="" "" - Q $P(PT(.11),"^",4) - ; -STATE() ; Get State for Home Address; PUBLIC; Extrinsic - ; PREREQ: PT Defined - Q:$G(PT(.11))="" "" - ; State is stored as a pointer - N STATENUM S STATENUM=$P(PT(.11),"^",5) - ; - ; State File Global is below - ; ^DIC(5,D0,0)= (#.01) NAME [1] ^ (#1) ABBREVIATION [2F] ^ (#2) VA STATE CODE - ; ==>[3F] ^ (#5) CAPITAL [4F] ^ (#2.1) AAC RECOGNIZED [5S] ^ (#2.2) - ; ==>US STATE OR POSSESSION [6S] ^ - Q:STATENUM="" "" ; To prevent global undefined below if no state - Q $P(^DIC(5,STATENUM,0),"^",1) - ; -ZIP() ; Get Zip code for Home Address; PUBLIC; Extrinsic - ; PREREQ: PT Defined - Q:$G(PT(.11))="" "" - Q $P(PT(.11),"^",6) - ; -COUNTY() ; Get County for our Address; PUBLIC; Extrinsic - ; PREREQ: PT Defined - Q:$G(PT(.11))="" "" - Q $P(PT(.11),"^",7) - ; -COUNTRY() ; Get Country for our Address; PUBLIC; Extrinsic - ; Unfortunately, I can't find where that is stored, so the inevitable... - Q:$G(PT(.11))="" "" - Q "USA" - ; -RESTEL() ; Residential Telephone; PUBLIC; Extrinsic - ; PREREQ: PT Defined - Q:$G(PT(.13))="" "" - Q $P(PT(.13),"^",1) - ; -WORKTEL() ; Work Telephone; PUBLIC; Extrinsic - ; PREREQ: PT Defined - Q:$G(PT(.13))="" "" - Q $P(PT(.13),"^",2) - ; -EMAIL() ; Email Adddress; PUBLIC; Extrinsic - ; PREREQ: PT Defined - Q:$G(PT(.13))="" "" - Q $P(PT(.13),"^",3) - ; -CELLTEL() ; Cell Phone; PUBLIC; Extrinsic - ; PREREQ: PT Defined - Q:$G(PT(.13))="" "" - Q $P(PT(.13),"^",4) - ; -NOK1FAM() ; Next of Kin 1 (NOK1) Family Name; PUBLIC; Extrinsic - ; PREREQ: PT Defined - Q:$G(PT(.21))="" "" - N NAME S NAME=$P(PT(.21),"^",1) - D NAMECOMP^XLFNAME(.NAME) - Q NAME("FAMILY") - ; -NOK1GIV() ; NOK1 Given Name; PUBLIC; Extrinsic - ; PREREQ: PT Defined - Q:$G(PT(.21))="" "" - N NAME S NAME=$P(PT(.21),"^",1) - D NAMECOMP^XLFNAME(.NAME) - Q NAME("GIVEN") - ; -NOK1MID() ; NOK1 Middle Name; PUBLIC; Extrinsic - ; PREREQ: PT Defined - Q:$G(PT(.21))="" "" - N NAME S NAME=$P(PT(.21),"^",1) - D NAMECOMP^XLFNAME(.NAME) - Q NAME("MIDDLE") - ; -NOK1SUF() ; NOK1 Suffi Name; PUBLIC; Extrinsic - ; PREREQ: PT Defined - Q:$G(PT(.21))="" "" - N NAME S NAME=$P(PT(.21),"^",1) - D NAMECOMP^XLFNAME(.NAME) - Q NAME("SUFFIX") - ; -NOK1DISP() ; NOK1 Display Name; PUBLIC; Extrinsic - ; PREREQ: PT Defined - Q:$G(PT(.21))="" "" - N NAME S NAME=$P(PT(.21),"^",1) - Q $$NAMEFMT^XLFNAME(.NAME,"G","MXc") - ; "G" is Given Name First; "MXc" is Mixed Case, With Suffx Preceded by Comma -NOK1REL() ; NOK1 Relationship to the patient; PUBLIC; Extrinsic - ; PREREQ: PT Defined - Q:$G(PT(.21))="" "" - Q $P(PT(.21),"^",2) - ; -NOK1ADD1() ; NOK1 Address 1; PUBLIC; Extrinsic - ; PREREQ: PT Defined - Q:$G(PT(.21))="" "" - Q $P(PT(.21),"^",3) - ; -NOK1ADD2() ; NOK1 Address 2; PUBLIC; Extrinsic - ; PREREQ: PT Defined - ; As before, CCR only allows two fileds for the address, so we have to compromise - Q:$G(PT(.21))="" "" - ; If the thrid address is empty, just return the 2nd. - ; If the 2nd is empty, we don't lose, b/c it will return "" - ; This is so that we won't produce a comma if there is no 3rd addr. - Q:$P(PT(.21),"^",5)="" $P(PT(.21),"^",4) - Q $P(PT(.21),"^",4)_", "_$P(PT(.21),"^",5) - ; -NOK1CITY() ; NOK1 City; PUBLIC; Extrinsic - ; PREREQ: PT Defined - Q:$G(PT(.21))="" "" - Q $P(PT(.21),"^",6) - ; -NOK1STAT() ; NOK1 State; PUBLIC; Extrinsic - ; PREREQ: PT Defined - Q:$G(PT(.21))="" "" - N STATENUM S STATENUM=$P(PT(.21),"^",7) - Q:STATENUM="" "" - Q $P(^DIC(5,STATENUM,0),"^",1) - ; -NOK1ZIP() ; NOK1 Zip Code; PUBLIC; Extrinsic - ; PREREQ: PT Defined - Q:$G(PT(.21))="" "" - Q $P(PT(.21),"^",8) - ; -NOK1HTEL() ; NOK1 Home Telephone; PUBLIC; Extrinsic - ; PREREQ: PT Defined - Q:$G(PT(.21))="" "" - Q $P(PT(.21),"^",9) - ; -NOK1WTEL() ; NOK1 Work Telephone; PUBLIC; Extrinsic - ; PREREQ: PT Defined - Q:$G(PT(.21))="" "" - Q $P(PT(.21),"^",11) - ; -NOK1SAME() ; Is NOK1's Address the same the patient?; PUBLIC; Extrinsic - ; PREREQ: PT Defined - Q:$G(PT(.21))="" "" - Q $P(PT(.21),"^",10) - ; -NOK2FAM() ; NOK2 Family Name; PUBLIC; Extrinsic - ; PREREQ: PT Defined - Q:$G(PT(.211))="" "" - N NAME S NAME=$P(PT(.211),"^",1) - D NAMECOMP^XLFNAME(.NAME) - Q NAME("FAMILY") - ; -NOK2GIV() ; NOK2 Given Name; PUBLIC; Extrinsic ; PREREQ: PT Defined - Q:$G(PT(.211))="" "" - N NAME S NAME=$P(PT(.211),"^",1) - D NAMECOMP^XLFNAME(.NAME) - Q NAME("GIVEN") - ; -NOK2MID() ; NOK2 Middle Name; PUBLIC; Extrinsic - ; PREREQ: PT Defined - Q:$G(PT(.211))="" "" - N NAME S NAME=$P(PT(.211),"^",1) - D NAMECOMP^XLFNAME(.NAME) - Q NAME("MIDDLE") - ; -NOK2SUF() ; NOK2 Suffi Name; PUBLIC; Extrinsic - ; PREREQ: PT Defined - Q:$G(PT(.211))="" "" - N NAME S NAME=$P(PT(.211),"^",1) - D NAMECOMP^XLFNAME(.NAME) - Q NAME("SUFFIX") -NOK2DISP() ; NOK2 Display Name; PUBLIC; Extrinsic - ; PREREQ: PT Defined - Q:$G(PT(.211))="" "" - N NAME S NAME=$P(PT(.211),"^",1) - Q $$NAMEFMT^XLFNAME(.NAME,"G","MXc") - ; "G" is Given Name First; "MXc" is Mixed Case, With Suffx Preceded by Comma -NOK2REL() ; NOK2 Relationship to the patient; PUBLIC; Extrinsic - ; PREREQ: PT Defined - Q:$G(PT(.211))="" "" - Q $P(PT(.211),"^",2) - ; -NOK2ADD1() ; NOK2 Address 1; PUBLIC; Extrinsic - ; PREREQ: PT Defined - Q:$G(PT(.211))="" "" - Q $P(PT(.211),"^",3) - ; -NOK2ADD2() ; NOK2 Address 2; PUBLIC; Extrinsic - ; PREREQ: PT Defined - ; As before, CCR only allows two fileds for the address, so we have to compromise - Q:$G(PT(.211))="" "" - ; If the thrid address is empty, just return the 2nd. - ; If the 2nd is empty, we don't lose, b/c it will return "" - ; This is so that we won't produce a comma if there is no 3rd addr. - Q:$P(PT(.211),"^",5)="" $P(PT(.211),"^",4) - Q $P(PT(.211),"^",4)_", "_$P(PT(.211),"^",5) - ; -NOK2CITY() ; NOK2 City; PUBLIC; Extrinsic - ; PREREQ: PT Defined - Q:$G(PT(.211))="" "" - Q $P(PT(.211),"^",6) - ; -NOK2STAT() ; NOK2 State; PUBLIC; Extrinsic - ; PREREQ: PT Defined - Q:$G(PT(.211))="" "" - N STATENUM S STATENUM=$P(PT(.211),"^",7) - Q:STATENUM="" "" ; To prevent global undefined below if no state - Q $P(^DIC(5,STATENUM,0),"^",1) ; Explained above - ; -NOK2ZIP() ; NOK2 Zip Code; PUBLIC; Extrinsic - ; PREREQ: PT Defined - Q:$G(PT(.211))="" "" - Q $P(PT(.211),"^",8) - ; -NOK2HTEL() ; NOK2 Home Telephone; PUBLIC; Extrinsic - ; PREREQ: PT Defined - Q:$G(PT(.211))="" "" - Q $P(PT(.211),"^",9) - ; -NOK2WTEL() ; NOK2 Work Telephone; PUBLIC; Extrinsic - ; PREREQ: PT Defined - Q:$G(PT(.211))="" "" - Q $P(PT(.211),"^",11) - ; -NOK2SAME() ; Is NOK2's Address the same the patient?; PUBLIC; Extrinsic - ; PREREQ: PT Defined - Q:$G(PT(.211))="" "" - Q $P(PT(.211),"^",10) - ; -EMERFAM() ; Emergency Contact (EMER) Family Name; PUBLIC; Extrinsic - ; PREREQ: PT Defined - Q:$G(PT(.33))="" "" - N NAME S NAME=$P(PT(.33),"^",1) - D NAMECOMP^XLFNAME(.NAME) - Q NAME("FAMILY") - ; -EMERGIV() ; EMER Given Name; PUBLIC; Extrinsic - ; PREREQ: PT Defined - Q:$G(PT(.33))="" "" - N NAME S NAME=$P(PT(.33),"^",1) - D NAMECOMP^XLFNAME(.NAME) - Q NAME("GIVEN") - ; -EMERMID() ; EMER Middle Name; PUBLIC; Extrinsic - ; PREREQ: PT Defined - Q:$G(PT(.33))="" "" - N NAME S NAME=$P(PT(.33),"^",1) - D NAMECOMP^XLFNAME(.NAME) - Q NAME("MIDDLE") - ; -EMERSUF() ; EMER Suffi Name; PUBLIC; Extrinsic - ; PREREQ: PT Defined - Q:$G(PT(.33))="" "" - N NAME S NAME=$P(PT(.33),"^",1) - D NAMECOMP^XLFNAME(.NAME) - Q NAME("SUFFIX") -EMERDISP() ; EMER Display Name; PUBLIC; Extrinsic - ; PREREQ: PT Defined - Q:$G(PT(.33))="" "" - N NAME S NAME=$P(PT(.33),"^",1) - Q $$NAMEFMT^XLFNAME(.NAME,"G","MXc") - ; "G" is Given Name First; "MXc" is Mixed Case, With Suffx Preceded by Comma -EMERREL() ; EMER Relationship to the patient; PUBLIC; Extrinsic - ; PREREQ: PT Defined - Q:$G(PT(.33))="" "" - Q $P(PT(.33),"^",2) - ; -EMERADD1() ; EMER Address 1; PUBLIC; Extrinsic - ; PREREQ: PT Defined - Q:$G(PT(.33))="" "" - Q $P(PT(.33),"^",3) - ; -EMERADD2() ; EMER Address 2; PUBLIC; Extrinsic - ; PREREQ: PT Defined - ; As before, CCR only allows two fileds for the address, so we have to compromise - Q:$G(PT(.33))="" "" - ; If the thrid address is empty, just return the 2nd. - ; If the 2nd is empty, we don't lose, b/c it will return "" - ; This is so that we won't produce a comma if there is no 3rd addr. - Q:$P(PT(.33),"^",5)="" $P(PT(.33),"^",4) - Q $P(PT(.33),"^",4)_", "_$P(PT(.33),"^",5) - ; -EMERCITY() ; EMER City; PUBLIC; Extrinsic - ; PREREQ: PT Defined - Q:$G(PT(.33))="" "" - Q $P(PT(.33),"^",6) - ; -EMERSTAT() ; EMER State; PUBLIC; Extrinsic - ; PREREQ: PT Defined - Q:$G(PT(.33))="" "" - N STATENUM S STATENUM=$P(PT(.33),"^",7) - Q:STATENUM="" "" ; To prevent global undefined below if no state - Q $P(^DIC(5,STATENUM,0),"^",1) ; Explained above - ; -EMERZIP() ; EMER Zip Code; PUBLIC; Extrinsic - ; PREREQ: PT Defined - Q:$G(PT(.33))="" "" - Q $P(PT(.33),"^",8) - ; -EMERHTEL() ; EMER Home Telephone; PUBLIC; Extrinsic - ; PREREQ: PT Defined - Q:$G(PT(.33))="" "" - Q $P(PT(.33),"^",9) - ; -EMERWTEL() ; EMER Work Telephone; PUBLIC; Extrinsic - ; PREREQ: PT Defined - Q:$G(PT(.33))="" "" - Q $P(PT(.33),"^",11) - ; -EMERSAME() ; Is EMER's Address the same the NOK?; PUBLIC; Extrinsic - ; PREREQ: PT Defined - Q:$G(PT(.33))="" "" - Q $P(PT(.33),"^",10) - ; +CCRDPT ;WV/CCRCCD/SMH - Routines to Extract Patient Data for CCDCCR; 6/15/08 + ;;0.2;CCRCCD;;Jun 15, 2008; + ; + ; Copyright 2008 WorldVistA. Licensed under the terms of the GNU + ; General Public License. + ; + ; This program is distributed in the hope that it will be useful, + ; but WITHOUT ANY WARRANTY; without even the implied warranty of + ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + ; GNU General Public License for more details. + ; + ; 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. + ; + ; CCRDPT CCRCCD/SMH - Routines to Extract Patient Data for + ; FAMILY Family Name + ; GIVEN Given Name + ; MIDDLE Middle Name + ; SUFFIX Suffix Name + ; DISPNAME Display Name + ; DOB Date of Birth + ; GENDER Get Gender + ; SSN Get SSN for ID + ; ADDRTYPE Get Home Address + ; ADDR1 Get Home Address line 1 + ; ADDR2 Get Home Address line 2 + ; CITY Get City for Home Address + ; STATE Get State for Home Address + ; ZIP Get Zip code for Home Address + ; COUNTY Get County for our Address + ; COUNTRY Get Country for our Address + ; RESTEL Residential Telephone + ; WORKTEL Work Telephone + ; EMAIL Email Adddress + ; CELLTEL Cell Phone + ; NOK1FAM Next of Kin 1 (NOK1) Family Name + ; NOK1GIV NOK1 Given Name + ; NOK1MID NOK1 Middle Name + ; NOK1SUF NOK1 Suffi Name + ; NOK1DISP NOK1 Display Name + ; NOK1REL NOK1 Relationship to the patient + ; NOK1ADD1 NOK1 Address 1 + ; NOK1ADD2 NOK1 Address 2 + ; NOK1CITY NOK1 City + ; NOK1STAT NOK1 State + ; NOK1ZIP NOK1 Zip Code + ; NOK1HTEL NOK1 Home Telephone + ; NOK1WTEL NOK1 Work Telephone + ; NOK1SAME Is NOK1's Address the same the patient? + ; NOK2FAM NOK2 Family Name + ; NOK2GIV NOK2 Given Name + ; NOK2MID NOK2 Middle Name + ; NOK2SUF NOK2 Suffi Name + ; NOK2DISP NOK2 Display Name + ; NOK2REL NOK2 Relationship to the patient + ; NOK2ADD1 NOK2 Address 1 + ; NOK2ADD2 NOK2 Address 2 + ; NOK2CITY NOK2 City + ; NOK2STAT NOK2 State + ; NOK2ZIP NOK2 Zip Code + ; NOK2HTEL NOK2 Home Telephone + ; NOK2WTEL NOK2 Work Telephone + ; NOK2SAME Is NOK2's Address the same the patient? + ; EMERFAM Emergency Contact (EMER) Family Name + ; EMERGIV EMER Given Name + ; EMERMID EMER Middle Name + ; EMERSUF EMER Suffi Name + ; EMERDISP EMER Display Name + ; EMERREL EMER Relationship to the patient + ; EMERADD1 EMER Address 1 + ; EMERADD2 EMER Address 2 + ; EMERCITY EMER City + ; EMERSTAT EMER State + ; EMERZIP EMER Zip Code + ; EMERHTEL EMER Home Telephone + ; EMERWTEL EMER Work Telephone + ; EMERSAME Is EMER's Address the same the NOK? + ; + W "No Entry at top!" Q + ; + ;**Revision History** + ; - June 15, 08: v0.1 using merged global + ; - Oct 3, 08: v0.2 using fileman calls, many formatting changes. + ; + ; All methods are Public and Extrinsic + ; All calls use Fileman file 2 (Patient). + ; You can obtain field numbers using the data dictionary + ; +FAMILY(DFN) ; Family Name + N NAME S NAME=$$GET1^DIQ(2,DFN,.01) + D NAMECOMP^XLFNAME(.NAME) + Q NAME("FAMILY") +GIVEN(DFN) ; Given Name + N NAME S NAME=$$GET1^DIQ(2,DFN,.01) + D NAMECOMP^XLFNAME(.NAME) + Q NAME("GIVEN") +MIDDLE(DFN) ; Middle Name + N NAME S NAME=$$GET1^DIQ(2,DFN,.01) + D NAMECOMP^XLFNAME(.NAME) + Q NAME("MIDDLE") +SUFFIX(DFN) ; Suffi Name + N NAME S NAME=$$GET1^DIQ(2,DFN,.01) + D NAMECOMP^XLFNAME(.NAME) + Q NAME("SUFFIX") +DISPNAME(DFN) ; Display Name + N NAME S NAME=$$GET1^DIQ(2,DFN,.01) + ; "G" is Given Name First; "MXc" is Mixed Case, With Suffx Preceded by Comma + Q $$NAMEFMT^XLFNAME(.NAME,"G","MXc") +DOB(DFN) ; Date of Birth + N DOB S DOB=$$GET1^DIQ(2,DFN,.03,"I") + ; Date in FM Date Format. Convert to UTC/ISO 8601. + Q $$FMDTOUTC^CCRUTIL(DOB,"D") +GENDER(DFN) ; Gender/Sex + Q $$GET1^DIQ(2,DFN,.02) ; +SSN(DFN) ; SSN + Q $$GET1^DIQ(2,DFN,.09) +ADDRTYPE(DFN) ; Address Type + ; Vista only stores a home address for the patient. + Q "Home" +ADDR1(DFN) ; Get Home Address line 1 + Q $$GET1^DIQ(2,DFN,.111) +ADDR2(DFN) ; Get Home Address line 2 + ; Vista has Lines 2,3; CCR has only line 1,2; so compromise + N ADDLN2,ADDLN3 + S ADDLN2=$$GET1^DIQ(2,DFN,.112),ADDLN3=$$GET1^DIQ(2,DFN,.113) + Q:ADDLN3="" ADDLN2 + Q ADDLN2_", "_ADDLN3 +CITY(DFN) ; Get City for Home Address + Q $$GET1^DIQ(2,DFN,.114) +STATE(DFN) ; Get State for Home Address + Q $$GET1^DIQ(2,DFN,.115) +ZIP(DFN) ; Get Zip code for Home Address + Q $$GET1^DIQ(2,DFN,.116) +COUNTY(DFN) ; Get County for our Address + Q $$GET1^DIQ(2,DFN,.117) +COUNTRY(DFN) ; Get Country for our Address + ; Unfortunately, it's not stored anywhere in Vista, so the inevitable... + Q "USA" +RESTEL(DFN) ; Residential Telephone + Q $$GET1^DIQ(2,DFN,.131) +WORKTEL(DFN) ; Work Telephone + Q $$GET1^DIQ(2,DFN,.132) +EMAIL(DFN) ; Email Adddress + Q $$GET1^DIQ(2,DFN,.133) +CELLTEL(DFN) ; Cell Phone + Q $$GET1^DIQ(2,DFN,.134) +NOK1FAM(DFN) ; Next of Kin 1 (NOK1) Family Name + N NAME S NAME=$$GET1^DIQ(2,DFN,.211) + D NAMECOMP^XLFNAME(.NAME) + Q NAME("FAMILY") +NOK1GIV(DFN) ; NOK1 Given Name + N NAME S NAME=$$GET1^DIQ(2,DFN,.211) + D NAMECOMP^XLFNAME(.NAME) + Q NAME("GIVEN") +NOK1MID(DFN) ; NOK1 Middle Name + N NAME S NAME=$$GET1^DIQ(2,DFN,.211) + D NAMECOMP^XLFNAME(.NAME) + Q NAME("MIDDLE") +NOK1SUF(DFN) ; NOK1 Suffi Name + N NAME S NAME=$$GET1^DIQ(2,DFN,.211) + D NAMECOMP^XLFNAME(.NAME) + Q NAME("SUFFIX") +NOK1DISP(DFN) ; NOK1 Display Name + N NAME S NAME=$$GET1^DIQ(2,DFN,.211) + ; "G" is Given Name First; "MXc" is Mixed Case, With Suffx Preceded by Comma + Q $$NAMEFMT^XLFNAME(.NAME,"G","MXc") +NOK1REL(DFN) ; NOK1 Relationship to the patient + Q $$GET1^DIQ(2,DFN,.212) +NOK1ADD1(DFN) ; NOK1 Address 1 + Q $$GET1^DIQ(2,DFN,.213) +NOK1ADD2(DFN) ; NOK1 Address 2 + N ADDLN2,ADDLN3 + S ADDLN2=$$GET1^DIQ(2,DFN,.214),ADDLN3=$$GET1^DIQ(2,DFN,.215) + Q:ADDLN3="" ADDLN2 + Q ADDLN2_", "_ADDLN3 +NOK1CITY(DFN) ; NOK1 City + Q $$GET1^DIQ(2,DFN,.216) +NOK1STAT(DFN) ; NOK1 State + Q $$GET1^DIQ(2,DFN,.217) +NOK1ZIP(DFN) ; NOK1 Zip Code + Q $$GET1^DIQ(2,DFN,.218) +NOK1HTEL(DFN) ; NOK1 Home Telephone + Q $$GET1^DIQ(2,DFN,.219) +NOK1WTEL(DFN) ; NOK1 Work Telephone + Q $$GET1^DIQ(2,DFN,.21011) +NOK1SAME(DFN) ; Is NOK1's Address the same the patient? + Q $$GET1^DIQ(2,DFN,.2125) +NOK2FAM(DFN) ; NOK2 Family Name + N NAME S NAME=$$GET1^DIQ(2,DFN,.2191) + D NAMECOMP^XLFNAME(.NAME) + Q NAME("FAMILY") +NOK2GIV(DFN) ; NOK2 Given Name + N NAME S NAME=$$GET1^DIQ(2,DFN,.2191) + D NAMECOMP^XLFNAME(.NAME) + Q NAME("GIVEN") +NOK2MID(DFN) ; NOK2 Middle Name + N NAME S NAME=$$GET1^DIQ(2,DFN,.2191) + D NAMECOMP^XLFNAME(.NAME) + Q NAME("MIDDLE") +NOK2SUF(DFN) ; NOK2 Suffi Name + N NAME S NAME=$$GET1^DIQ(2,DFN,.2191) + D NAMECOMP^XLFNAME(.NAME) + Q NAME("SUFFIX") +NOK2DISP(DFN) ; NOK2 Display Name + N NAME S NAME=$$GET1^DIQ(2,DFN,.2191) + ; "G" is Given Name First; "MXc" is Mixed Case, With Suffx Preceded by Comma + Q $$NAMEFMT^XLFNAME(.NAME,"G","MXc") +NOK2REL(DFN) ; NOK2 Relationship to the patient + Q $$GET1^DIQ(2,DFN,.2192) +NOK2ADD1(DFN) ; NOK2 Address 1 + Q $$GET1^DIQ(2,DFN,.2193) +NOK2ADD2(DFN) ; NOK2 Address 2 + N ADDLN2,ADDLN3 + S ADDLN2=$$GET1^DIQ(2,DFN,.2194),ADDLN3=$$GET1^DIQ(2,DFN,.2195) + Q:ADDLN3="" ADDLN2 + Q ADDLN2_", "_ADDLN3 +NOK2CITY(DFN) ; NOK2 City + Q $$GET1^DIQ(2,DFN,.2196) +NOK2STAT(DFN) ; NOK2 State + Q $$GET1^DIQ(2,DFN,.2197) +NOK2ZIP(DFN) ; NOK2 Zip Code + Q $$GET1^DIQ(2,DFN,.2198) +NOK2HTEL(DFN) ; NOK2 Home Telephone + Q $$GET1^DIQ(2,DFN,.2199) +NOK2WTEL(DFN) ; NOK2 Work Telephone + Q $$GET1^DIQ(2,DFN,.211011) +NOK2SAME(DFN) ; Is NOK2's Address the same the patient? + Q $$GET1^DIQ(2,DFN,.21925) +EMERFAM(DFN) ; Emergency Contact (EMER) Family Name + N NAME S NAME=$$GET1^DIQ(2,DFN,.331) + D NAMECOMP^XLFNAME(.NAME) + Q NAME("FAMILY") +EMERGIV(DFN) ; EMER Given Name + N NAME S NAME=$$GET1^DIQ(2,DFN,.331) + D NAMECOMP^XLFNAME(.NAME) + Q NAME("GIVEN") +EMERMID(DFN) ; EMER Middle Name + N NAME S NAME=$$GET1^DIQ(2,DFN,.331) + D NAMECOMP^XLFNAME(.NAME) + Q NAME("MIDDLE") +EMERSUF(DFN) ; EMER Suffi Name + N NAME S NAME=$$GET1^DIQ(2,DFN,.331) + D NAMECOMP^XLFNAME(.NAME) + Q NAME("SUFFIX") +EMERDISP(DFN) ; EMER Display Name + N NAME S NAME=$$GET1^DIQ(2,DFN,.331) + ; "G" is Given Name First; "MXc" is Mixed Case, With Suffx Preceded by Comma + Q $$NAMEFMT^XLFNAME(.NAME,"G","MXc") +EMERREL(DFN) ; EMER Relationship to the patient + Q $$GET1^DIQ(2,DFN,.331) +EMERADD1(DFN) ; EMER Address 1 + Q $$GET1^DIQ(2,DFN,.333) +EMERADD2(DFN) ; EMER Address 2 + N ADDLN2,ADDLN3 + S ADDLN2=$$GET1^DIQ(2,DFN,.334),ADDLN3=$$GET1^DIQ(2,DFN,.335) + Q:ADDLN3="" ADDLN2 + Q ADDLN2_", "_ADDLN3 +EMERCITY(DFN) ; EMER City + Q $$GET1^DIQ(2,DFN,.336) +EMERSTAT(DFN) ; EMER State + Q $$GET1^DIQ(2,DFN,.337) +EMERZIP(DFN) ; EMER Zip Code + Q $$GET1^DIQ(2,DFN,.338) +EMERHTEL(DFN) ; EMER Home Telephone + Q $$GET1^DIQ(2,DFN,.339) +EMERWTEL(DFN) ; EMER Work Telephone + Q $$GET1^DIQ(2,DFN,.33011) +EMERSAME(DFN) ; Is EMER's Address the same the NOK? + Q $$GET1^DIQ(2,DFN,.3305) Index: ccr/trunk/p/CCRDPTT.m =================================================================== --- ccr/trunk/p/CCRDPTT.m (revision 174) +++ ccr/trunk/p/CCRDPTT.m (revision 175) @@ -36,10 +36,8 @@ ; W "You have selected patient "_Y,!! - D INIT^CCRDPT($P(Y,"^")) - ; ZWR PT - N I S I=165 F S I=$O(OUT(I)) Q:I="" D + N I S I=89 F S I=$O(OUT(I)) Q:I="ALINE" D . W "OUT("_I_",0)"_" is "_$P(OUT(I,0)," ")_" " . W "valued at " - . W @("$$"_$P(OUT(I,0),"()")_"^"_"CCRDPT"_"()") + . W @("$$"_$P(OUT(I,0),"(DFN)")_"^"_"CCRDPT"_"("_$P(Y,"^")_")") . W ! Q Index: ccr/trunk/p/CCRUNIT.m =================================================================== --- ccr/trunk/p/CCRUNIT.m (revision 174) +++ ccr/trunk/p/CCRUNIT.m (revision 175) @@ -14,8 +14,7 @@ W "QUERY^GPLXPATH(T,XPATH,""MINXML"")",!! D QUERY^GPLXPATH(T,XPATH,"MINXML") - B W "Executing EXTRACT^CCRMEDS(MINXML,DFN,OUTXML)",! W "OUTXML will be ^TMP($J,""OUT"")",! N OUTXML S OUTXML=$NA(^TMP($J,"OUT")) - D EXTRACT^CCRMEDS("MINXML",DFN,OUTXML) + D EXTRACT^CCRMEDS($NA(MINXML),DFN,OUTXML) Q Index: ccr/trunk/p/GPLACTOR.m =================================================================== --- ccr/trunk/p/GPLACTOR.m (revision 174) +++ ccr/trunk/p/GPLACTOR.m (revision 175) @@ -1,133 +1,131 @@ GPLACTOR ; CCDCCR/GPL - CCR/CCD PROCESSING FOR ACTORS ; 7/3/08 - ;;0.3;CCDCCR;nopatch;noreleasedate - ;Copyright 2008 WorldVistA. Licensed under the terms of the GNU - ;General Public License See attached copy of the License. + ;;0.4;CCDCCR;nopatch;noreleasedate + ; Copyright 2008 WorldVistA. Licensed under the terms of the GNU + ; General Public License See attached copy of the License. + ; + ; This program is free software; you can redistribute it and/or modify + ; it under the terms of the GNU General Public License as published by + ; the Free Software Foundation; either version 2 of the License, or + ; (at your option) any later version. + ; + ; This program is distributed in the hope that it will be useful, + ; but WITHOUT ANY WARRANTY; without even the implied warranty of + ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + ; GNU General Public License for more details. + ; + ; 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. ; - ;This program is free software; you can redistribute it and/or modify - ;it under the terms of the GNU General Public License as published by - ;the Free Software Foundation; either version 2 of the License, or - ;(at your option) any later version. + ; PROCESS THE ACTORS SECTION OF THE CCR ; - ;This program is distributed in the hope that it will be useful, - ;but WITHOUT ANY WARRANTY; without even the implied warranty of - ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - ;GNU General Public License for more details. + ; ===Revision History=== + ; 0.1 Initial Writing of Skeleton--GPL + ; 0.2 Patient Data Extraction--SMH + ; 0.3 Information System Info Extraction--SMH + ; 0.4 Patient data rouine refactored; adjustments here--SMH ; - ;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 - ; EXTRACT(IPXML,ALST,AXML) ; EXTRACT ACTOR FROM ALST INTO PROVIDED XML TEMPLATE - ; 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" - ; 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 - D REPLACE^GPLXPATH(AXML,"","//Actors") ; DELETE THE INSIDES - I DEBUG W "PROCESSING ACTORS ",! - F I=1:1:@ALST@(0) D ; PROCESS ALL ACTORS IN THE LIST - . I @ALST@(I)["@@" Q ; NOT A VALID ACTOR - . S AOID=$P(@ALST@(I),"^",1) ; ACTOR OBJECT ID - . S ATYP=$P(@ALST@(I),"^",2) ; ACTOR TYPE - . S AIEN=$P(@ALST@(I),"^",3) ; ACTOR RECORD NUMBER - . I ATYP="" Q ; NOT A VALID ACTOR - . ; - . I DEBUG W AOID_" "_ATYP_" "_AIEN,! - . I ATYP="PATIENT" D ; PATIENT ACTOR TYPE - . . D QUERY^GPLXPATH(IPXML,"//Actors/ACTOR-PATIENT","ATMP") - . . D PATIENT("ATMP",AIEN,AOID,"ATMP2") - . ; - . I ATYP="SYSTEM" D ; SYSTEM ACTOR TYPE - . . D QUERY^GPLXPATH(IPXML,"//Actors/ACTOR-SYSTEM","ATMP") - . . D SYSTEM("ATMP",AIEN,AOID,"ATMP2") - . ; - . I ATYP="NOK" D ; NOK ACTOR TYPE - . . D QUERY^GPLXPATH(IPXML,"//Actors/ACTOR-NOK","ATMP") - . . D NOK("ATMP",AIEN,AOID,"ATMP2") - . ; - . I ATYP="PROVIDER" D ; PROVIDER ACTOR TYPE - . . D QUERY^GPLXPATH(IPXML,"//Actors/ACTOR-PROVIDER","ATMP") - . . D PROVIDER("ATMP",AIEN,AOID,"ATMP2") - . ; - . I ATYP="ORGANIZATION" D ; PROVIDER ACTOR TYPE - . . D QUERY^GPLXPATH(IPXML,"//Actors/ACTOR-ORG","ATMP") - . . D ORG("ATMP",AIEN,AOID,"ATMP2") - . ; - . D INSINNER^GPLXPATH(AXML,"ATMP2") ; INSERT INTO ROOT - ; - N ACTTMP - D MISSING^GPLXPATH(AXML,"ACTTMP") ; SEARCH XML FOR MISSING VARS - I ACTTMP(0)>0 D ; IF THERE ARE MISSING VARS - - . ; STRINGS MARKED AS @@X@@ - . W "ACTORS Missing list: ",! - . F I=1:1:ACTTMP(0) W ACTTMP(I),! - Q - ; + ; 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" + ; 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 + D REPLACE^GPLXPATH(AXML,"","//Actors") ; DELETE THE INSIDES + I DEBUG W "PROCESSING ACTORS ",! + F I=1:1:@ALST@(0) D ; PROCESS ALL ACTORS IN THE LIST + . I @ALST@(I)["@@" Q ; NOT A VALID ACTOR + . S AOID=$P(@ALST@(I),"^",1) ; ACTOR OBJECT ID + . S ATYP=$P(@ALST@(I),"^",2) ; ACTOR TYPE + . S AIEN=$P(@ALST@(I),"^",3) ; ACTOR RECORD NUMBER + . I ATYP="" Q ; NOT A VALID ACTOR + . ; + . I DEBUG W AOID_" "_ATYP_" "_AIEN,! + . I ATYP="PATIENT" D ; PATIENT ACTOR TYPE + . . D QUERY^GPLXPATH(IPXML,"//Actors/ACTOR-PATIENT","ATMP") + . . D PATIENT("ATMP",AIEN,AOID,"ATMP2") + . ; + . I ATYP="SYSTEM" D ; SYSTEM ACTOR TYPE + . . D QUERY^GPLXPATH(IPXML,"//Actors/ACTOR-SYSTEM","ATMP") + . . D SYSTEM("ATMP",AIEN,AOID,"ATMP2") + . ; + . I ATYP="NOK" D ; NOK ACTOR TYPE + . . D QUERY^GPLXPATH(IPXML,"//Actors/ACTOR-NOK","ATMP") + . . D NOK("ATMP",AIEN,AOID,"ATMP2") + . ; + . I ATYP="PROVIDER" D ; PROVIDER ACTOR TYPE + . . D QUERY^GPLXPATH(IPXML,"//Actors/ACTOR-PROVIDER","ATMP") + . . D PROVIDER("ATMP",AIEN,AOID,"ATMP2") + . ; + . I ATYP="ORGANIZATION" D ; PROVIDER ACTOR TYPE + . . D QUERY^GPLXPATH(IPXML,"//Actors/ACTOR-ORG","ATMP") + . . D ORG("ATMP",AIEN,AOID,"ATMP2") + . ; + . D INSINNER^GPLXPATH(AXML,"ATMP2") ; INSERT INTO ROOT + ; + N ACTTMP + D MISSING^GPLXPATH(AXML,"ACTTMP") ; SEARCH XML FOR MISSING VARS + I ACTTMP(0)>0 D ; IF THERE ARE MISSING VARS - + . ; STRINGS MARKED AS @@X@@ + . W "ACTORS Missing list: ",! + . F I=1:1:ACTTMP(0) W ACTTMP(I),! + Q + ; PATIENT(INXML,AIEN,AOID,OUTXML) ; PROCESS A PATIENT ACTOR - ; - I DEBUG W "PROCESSING ACTOR PATIENT ",AIEN,! - N AMAP,ZX - S AMAP=$NA(^TMP($J,"AMAP")) - K @AMAP - D INIT^CCRDPT(AIEN) - S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID - S @AMAP@("ACTORGIVENNAME")=$$GIVEN^CCRDPT - S @AMAP@("ACTORMIDDLENAME")=$$MIDDLE^CCRDPT - S @AMAP@("ACTORFAMILYNAME")=$$FAMILY^CCRDPT - S @AMAP@("ACTORDATEOFBIRTH")=$$DOB^CCRDPT - S @AMAP@("ACTORGENDER")=$$GENDER^CCRDPT - 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")="" - 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@("ACTORSOURCEID")="ACTORSYSTEM_1" ; THE SYSTEM IS THE SOURCE - D DESTROY^CCRDPT - D MAP^GPLXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE - Q - ; + I DEBUG W "PROCESSING ACTOR PATIENT ",AIEN,! + N AMAP,ZX + S AMAP=$NA(^TMP($J,"AMAP")) + K @AMAP + S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID + S @AMAP@("ACTORGIVENNAME")=$$GIVEN^CCRDPT(AIEN) + S @AMAP@("ACTORMIDDLENAME")=$$MIDDLE^CCRDPT(AIEN) + S @AMAP@("ACTORFAMILYNAME")=$$FAMILY^CCRDPT(AIEN) + S @AMAP@("ACTORDATEOFBIRTH")=$$DOB^CCRDPT(AIEN) + S @AMAP@("ACTORGENDER")=$$GENDER^CCRDPT(AIEN) + S @AMAP@("ACTORSSN")="" + S @AMAP@("ACTORSSNTEXT")="" + S @AMAP@("ACTORSSNSOURCEID")="" + S ZX=$$SSN^CCRDPT(AIEN) + 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(AIEN) + S @AMAP@("ACTORADDRESSLINE1")=$$ADDR1^CCRDPT(AIEN) + S @AMAP@("ACTORADDRESSLINE2")=$$ADDR2^CCRDPT(AIEN) + S @AMAP@("ACTORADDRESSCITY")=$$CITY^CCRDPT(AIEN) + S @AMAP@("ACTORADDRESSSTATE")=$$STATE^CCRDPT(AIEN) + S @AMAP@("ACTORADDRESSZIPCODE")=$$ZIP^CCRDPT(AIEN) + S @AMAP@("ACTORRESTEL")="" + S @AMAP@("ACTORRESTELTEXT")="" + S ZX=$$RESTEL^CCRDPT(AIEN) + 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(AIEN) + 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(AIEN) + 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(AIEN) + S @AMAP@("ACTORADDRESSSOURCEID")=AOID + S @AMAP@("ACTORIEN")=AIEN + S @AMAP@("ACTORSUFFIXNAME")="" ; DOES VISTA STORE THE SUFFIX + S @AMAP@("ACTORSOURCEID")="ACTORSYSTEM_1" ; THE SYSTEM IS THE SOURCE + D MAP^GPLXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE + Q + ; SYSTEM(INXML,AIEN,AOID,OUTXML) ; PROCESS A SYSTEM ACTOR ;