Index: /ccr/trunk/p/CCRDPT.m =================================================================== --- /ccr/trunk/p/CCRDPT.m (revision 39) +++ /ccr/trunk/p/CCRDPT.m (revision 40) @@ -1,545 +1,545 @@ 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. - - ; 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] ^ - + ;;0.1;CCRCCD;;Jun 15, 2008; + + ; 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] ^ + 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 - ; + ; 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 - ; + ; 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") - ; + ; 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") - ; + ; 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") - ; + ; 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") - ; + ; 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") - ; + ; 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 +OB() ; 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) - ; + ; 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) - ; + ; 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" - ; + ; 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) - ; + ; 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) - ; + ; 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) - ; + ; 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) - ; + ; 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) - ; + ; 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) - ; + ; 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" - ; + ; 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) - ; + ; 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) - ; + ; 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) - ; + ; 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) - ; + ; 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") - ; + ; 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") - ; + ; 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") - ; + ; 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") - ; + ; 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 + ; 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) - ; + ; 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) - ; + ; 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) - ; + ; 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) - ; + ; 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) - ; + ; 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) - ; + ; 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) - ; + ; 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) - ; + ; 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) - ; + ; 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") - ; + ; 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") - ; + 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") - ; + ; 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") + ; 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 + ; 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) - ; + ; 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) - ; + ; 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) - ; + ; 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) - ; + ; 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 - ; + ; 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) - ; + ; 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) - ; + ; 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) - ; + ; 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) - ; + ; 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") - ; + ; 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") - ; + ; 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") - ; + ; 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") + ; 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 + ; 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) - ; + ; 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) - ; + ; 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) - ; + ; 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) - ; + ; 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 - ; + ; 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) - ; + ; 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) - ; + ; 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) - ; + ; 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) - ; + ; PREREQ: PT Defined + Q:$G(PT(.33))="" "" + Q $P(PT(.33),"^",10) + ; Index: /ccr/trunk/p/CCRDPTT.m =================================================================== --- /ccr/trunk/p/CCRDPTT.m (revision 39) +++ /ccr/trunk/p/CCRDPTT.m (revision 40) @@ -1,28 +1,28 @@ -CCRDPTT; Unit Tester... - - ; Get the functions in the routine using Rick's routine - ; STATS(0)="CCRDPT^3080626.190908^396^14094^6414499860" - ; STATS(1,0)="CCRDPT ;CCRCCD/SMH - Routines to Extract Patient Data for CCDCCR; 6/15/08" - ; STATS(2,0)=" ;;0.1;CCRCCD;;Jun 15, 2008;" - ; STATS(84,0)="INIT(DFN) ; Copy DFN global to a local variable; PUBLIC" - ; STATS(93,0)="DESTROY ; Kill local variable; PUBLIC" - ; STATS(99,0)="FAMILY() ; Family Name; PUBLIC; Extrinsic" - ; STATS(105,0)="GIVEN() ; Given Name; PUBLIC; Extrinsic" - ; STATS(111,0)="MIDDLE() ; Middle Name; PUBLIC; Extrinsic " - ; etc. - - ; Load Routine Entry points; We get a sweeeeeet array - D ANALYZE^ARJTXRD("CCRDPT",.OUT) ; Analyze a routine in the directory - N X,Y - ; Select Patient - S DIC=2,DIC(0)="AEMQ" D ^DIC +CCRDPTT ; Unit Tester... + + ; Get the functions in the routine using Rick's routine + ; STATS(0)="CCRDPT^3080626.190908^396^14094^6414499860" + ; STATS(1,0)="CCRDPT ;CCRCCD/SMH - Routines to Extract Patient Data for CCDCCR; 6/15/08" + ; STATS(2,0)=" ;;0.1;CCRCCD;;Jun 15, 2008;" + ; STATS(84,0)="INIT(DFN) ; Copy DFN global to a local variable; PUBLIC" + ; STATS(93,0)="DESTROY ; Kill local variable; PUBLIC" + ; STATS(99,0)="FAMILY() ; Family Name; PUBLIC; Extrinsic" + ; STATS(105,0)="GIVEN() ; Given Name; PUBLIC; Extrinsic" + ; STATS(111,0)="MIDDLE() ; Middle Name; PUBLIC; Extrinsic " + ; etc. + + ; Load Routine Entry points; We get a sweeeeeet array + D ANALYZE^ARJTXRD("CCRDPT",.OUT) ; Analyze a routine in the directory + N X,Y + ; Select Patient + S DIC=2,DIC(0)="AEMQ" D ^DIC - 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 - . W "OUT("_I_",0)"_" is "_$P(OUT(I,0)," ")_" " - . W "valued at " - . W @("$$"_$P(OUT(I,0),"()")_"^"_"CCRDPT"_"()") - . W ! - Q + 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 + . W "OUT("_I_",0)"_" is "_$P(OUT(I,0)," ")_" " + . W "valued at " + . W @("$$"_$P(OUT(I,0),"()")_"^"_"CCRDPT"_"()") + . W ! + Q Index: /ccr/trunk/p/CCRUTIL.m =================================================================== --- /ccr/trunk/p/CCRUTIL.m (revision 39) +++ /ccr/trunk/p/CCRUTIL.m (revision 40) @@ -1,27 +1,27 @@ -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,FORMAT) ; Convert Fileman Date to UTC Date Format; PUBLIC; Extrinsic - ; FORMAT is Format of Date. Can be either D (Day) or DT (Date and Time) - ; If not passed, or passed incorrectly, it's assumed that it is D. - ; FM Date format is "YYYMMDD.HHMMSS" HHMMSS may not be supplied. - ; UTC date is formatted as follows: YYYY-MM-DDThh:mm:ss_offsetfromUTC - ; UTC, Year, Month, Day, Hours, Minutes, Seconds, Time offset (obtained from Mailman Site Parameters) - N UTC,Y,M,D,H,MM,S,OFF - S Y=1700+$E(DATE,1,3) - S M=$E(DATE,4,5) - S D=$E(DATE,6,7) - S H=$E(DATE,9,10) - S MM=$E(DATE,11,12) - S S=$E(DATE,13,14) - S OFF=$$TZ^XLFDT ; See Kernel Manual for documentation. - ; If H, MM and S are empty, it means that the FM date didn't supply the time. - ; In this case, set H, MM and S to "00" - S:('$L(H)&'$L(MM)&'$L(S)) (H,MM,S)="00" - I S="" S UTC=Y_"-"_M_"-"_D_"T"_H_":"_MM_OFF - E S UTC=Y_"-"_M_"-"_D_"T"_H_":"_MM_":"_S_OFF - I $L($G(FORMAT)),FORMAT="DT" Q UTC ; Date with time. - E Q $P(UTC,"T") - ; +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,FORMAT) ; Convert Fileman Date to UTC Date Format; PUBLIC; Extrinsic + ; FORMAT is Format of Date. Can be either D (Day) or DT (Date and Time) + ; If not passed, or passed incorrectly, it's assumed that it is D. + ; FM Date format is "YYYMMDD.HHMMSS" HHMMSS may not be supplied. + ; UTC date is formatted as follows: YYYY-MM-DDThh:mm:ss_offsetfromUTC + ; UTC, Year, Month, Day, Hours, Minutes, Seconds, Time offset (obtained from Mailman Site Parameters) + N UTC,Y,M,D,H,MM,S,OFF + S Y=1700+$E(DATE,1,3) + S M=$E(DATE,4,5) + S D=$E(DATE,6,7) + S H=$E(DATE,9,10) + S MM=$E(DATE,11,12) + S S=$E(DATE,13,14) + S OFF=$$TZ^XLFDT ; See Kernel Manual for documentation. + ; If H, MM and S are empty, it means that the FM date didn't supply the time. + ; In this case, set H, MM and S to "00" + S:('$L(H)&'$L(MM)&'$L(S)) (H,MM,S)="00" + I S="" S UTC=Y_"-"_M_"-"_D_"T"_H_":"_MM_OFF + E S UTC=Y_"-"_M_"-"_D_"T"_H_":"_MM_":"_S_OFF + I $L($G(FORMAT)),FORMAT="DT" Q UTC ; Date with time. + E Q $P(UTC,"T") + ; Index: /ccr/trunk/p/GPLACTORS.m =================================================================== --- /ccr/trunk/p/GPLACTORS.m (revision 39) +++ /ccr/trunk/p/GPLACTORS.m (revision 40) @@ -1,9 +1,9 @@ GPLACTORS ; CCDCCR/GPL - CCR/CCD PROCESSING FOR ACTORS ; 7/3/08 - ;;0.1;CCDCCR;nopatch;noreleasedate - ; - ; PROCESS THE ACTORS SECTION OF THE CCR - ; + ;;0.1;CCDCCR;nopatch;noreleasedate + ; + ; PROCESS THE ACTORS SECTION OF THE CCR + ; EXTRACT(IPXML,ALST,OUTXML) ; EXTRACT ACTOR FROM ALST INTO PROVIDED XML TEMPLATE - ; + ; N I,J,ATMP,FIRST,AMAP,AOID,ATYP,AIEN S FIRST=1 ; NEED TO KNOW WHICH IS THE FIRST ACTOR Index: /ccr/trunk/p/GPLCCD0.m =================================================================== --- /ccr/trunk/p/GPLCCD0.m (revision 39) +++ /ccr/trunk/p/GPLCCD0.m (revision 40) @@ -1,222 +1,222 @@ 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 - ; + ;;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 - ; + ; 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 - ; + D ZLOAD(ARY,"GPLCCD0") + ; ZWR @ARY + Q + ; ;