Changeset 122 for ccr/trunk


Ignore:
Timestamp:
Aug 30, 2008, 3:13:15 PM (16 years ago)
Author:
George Lilly
Message:

XINDEX fixes. almost clean except for long var names and big files

Location:
ccr/trunk/p
Files:
14 edited

Legend:

Unmodified
Added
Removed

  • ccr/trunk/p/CCRDPT.m

    r69 r122  
    11CCRDPT ;CCRCCD/SMH - Routines to Extract Patient Data for CCDCCR; 6/15/08
    2           ;;0.1;CCRCCD;;Jun 15, 2008;
     2  ;;0.1;CCRCCD;;Jun 15, 2008;
    33 ;Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
    44 ;General Public License See attached copy of the License.
    … …  
    1717 ;with this program; if not, write to the Free Software Foundation, Inc.,
    1818 ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
    19 
    20           ; NOTE TO PROGRAMMER: You need to call INIT(DPT) to initialize; and
    21           ; DESTROY to clean-up.
    22 
    23           ; The first line of every routine tests if the global exists.
    24 
    25           ; CCRDPT     83 lines  CCRCCD/SMH - Routines to Extract Patient Data for
    26           ; INIT        9 lines  Copy DFN global to a local variable
    27           ; DESTROY     6 lines  Kill local variable
    28           ; FAMILY      6 lines  Family Name
    29           ; GIVEN       6 lines  Given Name
    30           ; MIDDLE      6 lines  Middle Name
    31           ; SUFFIX      6 lines  Suffix Name
    32           ; DISPNAME    5 lines  Display Name
    33           ; DOB         6 lines  Date of Birth
    34           ; GENDER      4 lines  Get Gender
    35           ; SSN         4 lines  Get SSN for ID
    36           ; ADDRTYPE    4 lines  Get Home Address
    37           ; ADDR1       4 lines  Get Home Address line 1
    38           ; ADDR2       5 lines  Get Home Address line 2
    39           ; CITY        4 lines  Get City for Home Address
    40           ; STATE      11 lines  Get State for Home Address
    41           ; ZIP         4 lines  Get Zip code for Home Address
    42           ; COUNTY      4 lines  Get County for our Address
    43           ; COUNTRY     4 lines  Get Country for our Address
    44           ; RESTEL      4 lines  Residential Telephone
    45           ; WORKTEL     4 lines  Work Telephone
    46           ; EMAIL       4 lines  Email Adddress
    47           ; CELLTEL     4 lines  Cell Phone
    48           ; NOK1FAM     6 lines  Next of Kin 1 (NOK1) Family Name
    49           ; NOK1GIV     6 lines  NOK1 Given Name
    50           ; NOK1MID     6 lines  NOK1 Middle Name
    51           ; NOK1SUF     6 lines  NOK1 Suffi Name
    52           ; NOK1DISP    5 lines  NOK1 Display Name
    53           ; NOK1REL     4 lines  NOK1 Relationship to the patient
    54           ; NOK1ADD1    4 lines  NOK1 Address 1
    55           ; NOK1ADD2    5 lines  NOK1 Address 2
    56           ; NOK1CITY    4 lines  NOK1 City
    57           ; NOK1STAT    5 lines  NOK1 State
    58           ; NOK1ZIP     4 lines  NOK1 Zip Code
    59           ; NOK1HTEL;   4 lines  NOK1 Home Telephone
    60           ; NOK1WTEL;   4 lines  NOK1 Work Telephone
    61           ; NOK1SAME;   4 lines  Is NOK1's Address the same the patient?
    62           ; NOK2FAM     6 lines  NOK2 Family Name
    63           ; NOK2GIV     6 lines  NOK2 Given Name
    64           ; NOK2MID     6 lines  NOK2 Middle Name
    65           ; NOK2SUF     5 lines  NOK2 Suffi Name
    66           ; NOK2DISP    5 lines  NOK2 Display Name
    67           ; NOK2REL     4 lines  NOK2 Relationship to the patient
    68           ; NOK2ADD1    4 lines  NOK2 Address 1
    69           ; NOK2ADD2    5 lines  NOK2 Address 2
    70           ; NOK2CITY    4 lines  NOK2 City
    71           ; NOK2STAT    5 lines  NOK2 State
    72           ; NOK2ZIP     4 lines  NOK2 Zip Code
    73           ; NOK2HTEL;   4 lines  NOK2 Home Telephone
    74           ; NOK2WTEL;   4 lines  NOK2 Work Telephone
    75           ; NOK2SAME;   4 lines  Is NOK2's Address the same the patient?
    76           ; EMERFAM     6 lines  Emergency Contact (EMER) Family Name
    77           ; EMERGIV     6 lines  EMER Given Name
    78           ; EMERMID     6 lines  EMER Middle Name
    79           ; EMERSUF     5 lines  EMER Suffi Name
    80           ; EMERDISP    5 lines  EMER Display Name
    81           ; EMERREL     4 lines  EMER Relationship to the patient
    82           ; EMERADD1    4 lines  EMER Address 1
    83           ; EMERADD2    5 lines  EMER Address 2
    84           ; EMERCITY    4 lines  EMER City
    85           ; EMERSTAT    5 lines  EMER State
    86           ; EMERZIP     4 lines  EMER Zip Code
    87           ; EMERHTEL;   4 lines  EMER Home Telephone
    88           ; EMERWTEL;   4 lines  EMER Work Telephone
    89           ; EMERSAME;   4 lines  Is EMER's Address the same the NOK?
    90 
     19    ; NOTE TO PROGRAMMER: You need to call INIT(DPT) to initialize; and
     20    ; DESTROY to clean-up.
     21    ; The first line of every routine tests if the global exists.
     22    ;
     23    ; CCRDPT     83 lines  CCRCCD/SMH - Routines to Extract Patient Data for
     24    ; INIT        9 lines  Copy DFN global to a local variable
     25    ; DESTROY     6 lines  Kill local variable
     26    ; FAMILY      6 lines  Family Name
     27    ; GIVEN       6 lines  Given Name
     28    ; MIDDLE      6 lines  Middle Name
     29    ; SUFFIX      6 lines  Suffix Name
     30    ; DISPNAME    5 lines  Display Name
     31    ; DOB         6 lines  Date of Birth
     32    ; GENDER      4 lines  Get Gender
     33    ; SSN         4 lines  Get SSN for ID
     34    ; ADDRTYPE    4 lines  Get Home Address
     35    ; ADDR1       4 lines  Get Home Address line 1
     36    ; ADDR2       5 lines  Get Home Address line 2
     37    ; CITY        4 lines  Get City for Home Address
     38    ; STATE      11 lines  Get State for Home Address
     39    ; ZIP         4 lines  Get Zip code for Home Address
     40    ; COUNTY      4 lines  Get County for our Address
     41    ; COUNTRY     4 lines  Get Country for our Address
     42    ; RESTEL      4 lines  Residential Telephone
     43    ; WORKTEL     4 lines  Work Telephone
     44    ; EMAIL       4 lines  Email Adddress
     45    ; CELLTEL     4 lines  Cell Phone
     46    ; NOK1FAM     6 lines  Next of Kin 1 (NOK1) Family Name
     47    ; NOK1GIV     6 lines  NOK1 Given Name
     48    ; NOK1MID     6 lines  NOK1 Middle Name
     49    ; NOK1SUF     6 lines  NOK1 Suffi Name
     50    ; NOK1DISP    5 lines  NOK1 Display Name
     51    ; NOK1REL     4 lines  NOK1 Relationship to the patient
     52    ; NOK1ADD1    4 lines  NOK1 Address 1
     53    ; NOK1ADD2    5 lines  NOK1 Address 2
     54    ; NOK1CITY    4 lines  NOK1 City
     55    ; NOK1STAT    5 lines  NOK1 State
     56    ; NOK1ZIP     4 lines  NOK1 Zip Code
     57    ; NOK1HTEL;   4 lines  NOK1 Home Telephone
     58    ; NOK1WTEL;   4 lines  NOK1 Work Telephone
     59    ; NOK1SAME;   4 lines  Is NOK1's Address the same the patient?
     60    ; NOK2FAM     6 lines  NOK2 Family Name
     61    ; NOK2GIV     6 lines  NOK2 Given Name
     62    ; NOK2MID     6 lines  NOK2 Middle Name
     63    ; NOK2SUF     5 lines  NOK2 Suffi Name
     64    ; NOK2DISP    5 lines  NOK2 Display Name
     65    ; NOK2REL     4 lines  NOK2 Relationship to the patient
     66    ; NOK2ADD1    4 lines  NOK2 Address 1
     67    ; NOK2ADD2    5 lines  NOK2 Address 2
     68    ; NOK2CITY    4 lines  NOK2 City
     69    ; NOK2STAT    5 lines  NOK2 State
     70    ; NOK2ZIP     4 lines  NOK2 Zip Code
     71    ; NOK2HTEL;   4 lines  NOK2 Home Telephone
     72    ; NOK2WTEL;   4 lines  NOK2 Work Telephone
     73    ; NOK2SAME;   4 lines  Is NOK2's Address the same the patient?
     74    ; EMERFAM     6 lines  Emergency Contact (EMER) Family Name
     75    ; EMERGIV     6 lines  EMER Given Name
     76    ; EMERMID     6 lines  EMER Middle Name
     77    ; EMERSUF     5 lines  EMER Suffi Name
     78    ; EMERDISP    5 lines  EMER Display Name
     79    ; EMERREL     4 lines  EMER Relationship to the patient
     80    ; EMERADD1    4 lines  EMER Address 1
     81    ; EMERADD2    5 lines  EMER Address 2
     82    ; EMERCITY    4 lines  EMER City
     83    ; EMERSTAT    5 lines  EMER State
     84    ; EMERZIP     4 lines  EMER Zip Code
     85    ; EMERHTEL;   4 lines  EMER Home Telephone
     86    ; EMERWTEL;   4 lines  EMER Work Telephone
     87    ; EMERSAME;   4 lines  Is EMER's Address the same the NOK?
     88    ;
    9189          W "No Entry at top!" Q
    92 
    93           ; The following is a map of the relevant data in the patient global.
    94           ;
    95           ; ^DPT(D0,0)= (#.01) NAME [1F] ^ (#.02) SEX [2S] ^ (#.03) DATE OF BIRTH [3D] ^
    96           ; ==>^ (#.05) MARITAL STATUS [5P:11] ^ (#.06) RACE [6P:10] ^ (#.07)
    97           ; ==>OCCUPATION [7F] ^ (#.08) RELIGIOUS PREFERENCE [8P:13] ^ (#.09)
    98           ; ==>SOCIAL SECURITY NUMBER [9F] ^ (#.091) REMARKS [10F] ^ (#.092)
    99           ; ==>PLACE OF BIRTH [CITY] [11F] ^ (#.093) PLACE OF BIRTH [STATE]
    100           ; ==>[12P:5] ^  ^ (#.14) CURRENT MEANS TEST STATUS [14P:408.32] ^
    101           ; ==>(#.096) WHO ENTERED PATIENT [15P:200] ^ (#.097) DATE ENTERED INTO
    102           ; ==>FILE [16D] ^ (#.098) HOW WAS PATIENT ENTERED? [17S] ^ (#.081)
    103           ; ==>DUPLICATE STATUS [18S] ^ (#.082) PATIENT MERGED TO [19P:2] ^
    104           ; ==>(#.083) CHECK FOR DUPLICATE [20S] ^ (#.6) TEST PATIENT INDICATOR
    105           ; ==>[21S] ^
    106           ; ^DPT(D0,.01,0)=^2.01^^  (#1) ALIAS
    107           ; ^DPT(D0,.01,D1,0)= (#.01) ALIAS [1F] ^ (#1) ALIAS SSN [2F] ^ (#100.03) ALIAS
    108           ; ==>COMPONENTS [3P:20] ^
    109           ; ^DPT(D0,.11)= (#.111) STREET ADDRESS [LINE 1] [1F] ^ (#.112) STREET ADDRESS
    110           ; ==>[LINE 2] [2F] ^ (#.113) STREET ADDRESS [LINE 3] [3F] ^ (#.114)
    111           ; ==>CITY [4F] ^ (#.115) STATE [5P:5] ^ (#.116) ZIP CODE [6F] ^
    112           ; ==>(#.117) COUNTY [7N] ^  ^  ^  ^  ^ (#.1112) ZIP+4 [12F] ^
    113           ; ==>(#.118) ADDRESS CHANGE DT/TM [13D] ^ (#.119) ADDRESS CHANGE
    114           ; ==>SOURCE [14S] ^ (#.12) ADDRESS CHANGE SITE [15P:4] ^ (#.121) BAD
    115           ; ==>ADDRESS INDICATOR [16S] ^ (#.122) ADDRESS CHANGE USER [17P:200]
    116           ; ==>^
    117           ; ^DPT(D0,.121)= (#.1211) TEMPORARY STREET [LINE 1] [1F] ^ (#.1212) TEMPORARY
    118           ; ==>STREET [LINE 2] [2F] ^ (#.1213) TEMPORARY STREET [LINE 3] [3F]
    119           ; ==>^ (#.1214) TEMPORARY CITY [4F] ^ (#.1215) TEMPORARY STATE
    120           ; ==>[5P:5] ^ (#.1216) TEMPORARY ZIP CODE [6F] ^ (#.1217) TEMPORARY
    121           ; ==>ADDRESS START DATE [7D] ^ (#.1218) TEMPORARY ADDRESS END DATE
    122           ; ==>[8D] ^ (#.12105) TEMPORARY ADDRESS ACTIVE? [9S] ^ (#.1219)
    123           ; ==>TEMPORARY PHONE NUMBER [10F] ^ (#.12111) TEMPORARY ADDRESS
    124           ; ==>COUNTY [11N] ^ (#.12112) TEMPORARY ZIP+4 [12F] ^ (#.12113)
    125           ; ==>TEMPORARY ADDRESS CHANGE DT/TM [13D] ^
    126           ; ^DPT(D0,.121)= (#.12114) TEMPORARY ADDRESS CHANGE SITE [14P:4] ^
    127           ; ^DPT(D0,.13)= (#.131) PHONE NUMBER [RESIDENCE] [1F] ^ (#.132) PHONE NUMBER
    128           ; ==>[WORK] [2F] ^ (#.133) EMAIL ADDRESS [3F] ^ (#.134) PHONE NUMBER
    129           ; ==>[CELLULAR] [4F] ^ (#.135) PAGER NUMBER [5F] ^ (#.136) EMAIL
    130           ; ==>ADDRESS CHANGE DT/TM [6D] ^ (#.137) EMAIL ADDRESS CHANGE SOURCE
    131           ; ==>[7S] ^ (#.138) EMAIL ADDRESS CHANGE SITE [8P:4] ^ (#.139)
    132           ; ==>CELLULAR NUMBER CHANGE DT/TM [9D] ^ (#.1311) CELLULAR NUMBER
    133           ; ==>CHANGE SOURCE [10S] ^ (#.13111) CELLULAR NUMBER CHANGE SITE
    134           ; ==>[11P:4] ^ (#.1312) PAGER NUMBER CHANGE DT/TM [12D] ^ (#.1313)
    135           ; ==>PAGER NUMBER CHANGE SOURCE [13S] ^ (#.1314) PAGER NUMBER CHANGE
    136           ; ==>SITE [14P:4] ^
    137           ; ^DPT(D0,.21)= (#.211) K-NAME OF PRIMARY NOK [1F] ^ (#.212) K-RELATIONSHIP TO
    138           ; ==>PATIENT [2F] ^ (#.213) K-STREET ADDRESS [LINE 1] [3F] ^ (#.214)
    139           ; ==>K-STREET ADDRESS [LINE 2] [4F] ^ (#.215) K-STREET ADDRESS [LINE
    140           ; ==>3] [5F] ^
    141           ; ^DPT(D0,.21)= (#.216) K-CITY [6F] ^ (#.217) K-STATE [7P:5] ^ (#.218) K-ZIP
    142           ; ==>CODE [8F] ^ (#.219) K-PHONE NUMBER [9F] ^ (#.2125) K-ADDRESS
    143           ; ==>SAME AS PATIENT'S? [10S] ^ (#.21011) K-WORK PHONE NUMBER [11F]
    144           ; ==>^
    145           ; ^DPT(D0,.211)= (#.2191) K2-NAME OF SECONDARY NOK [1F] ^ (#.2192)
    146           ; ==>K2-RELATIONSHIP TO PATIENT [2F] ^ (#.2193) K2-STREET ADDRESS
    147           ; ==>[LINE 1] [3F] ^ (#.2194) K2-STREET ADDRESS [LINE 2] [4F] ^
    148           ; ==>(#.2195) K2-STREET ADDRESS [LINE 3] [5F] ^ (#.2196) K2-CITY
    149           ; ==>[6F] ^ (#.2197) K2-STATE [7P:5] ^ (#.2198) K2-ZIP CODE [8F] ^
    150           ; ==>(#.2199) K2-PHONE NUMBER [9F] ^ (#.21925) K2-ADDRESS SAME AS
    151           ; ==>PATIENT'S? [10S] ^ (#.211011) K2-WORK PHONE NUMBER [11F] ^
    152           ; ^DPT(D0,.25)= (#.251) SPOUSE'S EMPLOYER NAME [1F] ^ (#.252) SPOUSE'S EMP
    153           ; ==>STREET [LINE 1] [2F] ^ (#.253) SPOUSE'S EMP STREET [LINE 2]
    154           ; ==>[3F] ^ (#.254) SPOUSE'S EMP STREET [LINE 3] [4F] ^ (#.255)
    155           ; ==>SPOUSE'S EMPLOYER'S CITY [5F] ^ (#.256) SPOUSE'S EMPLOYER'S
    156           ; ==>STATE [6P:5] ^ (#.257) SPOUSE'S EMP ZIP CODE [7F] ^ (#.258)
    157           ; ==>SPOUSE'S EMP PHONE NUMBER [8F] ^  ^  ^  ^  ^  ^ (#.2514)
    158           ; ==>SPOUSE'S OCCUPATION [14F] ^ (#.2515) SPOUSE'S EMPLOYMENT STATUS
    159           ; ==>[15S] ^ (#.2516) SPOUSE'S RETIREMENT DATE [16D] ^
    160           ; ^DPT(D0,.33)= (#.331) E-NAME [1F] ^ (#.332) E-RELATIONSHIP TO PATIENT [2F] ^
    161           ; ==>(#.333) E-STREET ADDRESS [LINE 1] [3F] ^ (#.334) E-STREET
    162           ; ==>ADDRESS [LINE 2] [4F] ^ (#.335) E-STREET ADDRESS [LINE 3] [5F]
    163           ; ==>^ (#.336) E-CITY [6F] ^ (#.337) E-STATE [7P:5] ^ (#.338) E-ZIP
    164           ; ==>CODE [8F] ^ (#.339) E-PHONE NUMBER [9F] ^ (#.3305) E-EMER.
    165           ; ==>CONTACT SAME AS NOK? [10S] ^ (#.33011) E-WORK PHONE NUMBER
    166           ; ==>[11F] ^
    167 
    168 INIT(DFN) ; Copy DFN global to a local variable; PUBLIC
    169           ; INPUT: Patient IEN (DFN)
    170           ; OUTPUT: PT in the Symbol Table, representing the patient global
    171 
    172           ; Instead of accessing a global each single read (SLOOOOW)
    173           ; read it off a local variable stored in Memory.
     90   ; The following is a map of the relevant data in the patient global.
     91    ;
     92    ; ^DPT(D0,0)= (#.01) NAME [1F] ^ (#.02) SEX [2S] ^ (#.03) DATE OF BIRTH [3D] ^
     93    ; ==>^ (#.05) MARITAL STATUS [5P:11] ^ (#.06) RACE [6P:10] ^ (#.07)
     94    ; ==>OCCUPATION [7F] ^ (#.08) RELIGIOUS PREFERENCE [8P:13] ^ (#.09)
     95    ; ==>SOCIAL SECURITY NUMBER [9F] ^ (#.091) REMARKS [10F] ^ (#.092)
     96    ; ==>PLACE OF BIRTH [CITY] [11F] ^ (#.093) PLACE OF BIRTH [STATE]
     97    ; ==>[12P:5] ^  ^ (#.14) CURRENT MEANS TEST STATUS [14P:408.32] ^
     98    ; ==>(#.096) WHO ENTERED PATIENT [15P:200] ^ (#.097) DATE ENTERED INTO
     99    ; ==>FILE [16D] ^ (#.098) HOW WAS PATIENT ENTERED? [17S] ^ (#.081)
     100    ; ==>DUPLICATE STATUS [18S] ^ (#.082) PATIENT MERGED TO [19P:2] ^
     101    ; ==>(#.083) CHECK FOR DUPLICATE [20S] ^ (#.6) TEST PATIENT INDICATOR
     102    ; ==>[21S] ^
     103    ; ^DPT(D0,.01,0)=^2.01^^  (#1) ALIAS
     104    ; ^DPT(D0,.01,D1,0)= (#.01) ALIAS [1F] ^ (#1) ALIAS SSN [2F] ^ (#100.03) ALIAS
     105    ; ==>COMPONENTS [3P:20] ^
     106    ; ^DPT(D0,.11)= (#.111) STREET ADDRESS [LINE 1] [1F] ^ (#.112) STREET ADDRESS
     107    ; ==>[LINE 2] [2F] ^ (#.113) STREET ADDRESS [LINE 3] [3F] ^ (#.114)
     108    ; ==>CITY [4F] ^ (#.115) STATE [5P:5] ^ (#.116) ZIP CODE [6F] ^
     109    ; ==>(#.117) COUNTY [7N] ^  ^  ^  ^  ^ (#.1112) ZIP+4 [12F] ^
     110    ; ==>(#.118) ADDRESS CHANGE DT/TM [13D] ^ (#.119) ADDRESS CHANGE
     111    ; ==>SOURCE [14S] ^ (#.12) ADDRESS CHANGE SITE [15P:4] ^ (#.121) BAD
     112    ; ==>ADDRESS INDICATOR [16S] ^ (#.122) ADDRESS CHANGE USER [17P:200]
     113    ; ==>^
     114    ; ^DPT(D0,.121)= (#.1211) TEMPORARY STREET [LINE 1] [1F] ^ (#.1212) TEMPORARY
     115    ; ==>STREET [LINE 2] [2F] ^ (#.1213) TEMPORARY STREET [LINE 3] [3F]
     116    ; ==>^ (#.1214) TEMPORARY CITY [4F] ^ (#.1215) TEMPORARY STATE
     117    ; ==>[5P:5] ^ (#.1216) TEMPORARY ZIP CODE [6F] ^ (#.1217) TEMPORARY
     118    ; ==>ADDRESS START DATE [7D] ^ (#.1218) TEMPORARY ADDRESS END DATE
     119    ; ==>[8D] ^ (#.12105) TEMPORARY ADDRESS ACTIVE? [9S] ^ (#.1219)
     120    ; ==>TEMPORARY PHONE NUMBER [10F] ^ (#.12111) TEMPORARY ADDRESS
     121    ; ==>COUNTY [11N] ^ (#.12112) TEMPORARY ZIP+4 [12F] ^ (#.12113)
     122    ; ==>TEMPORARY ADDRESS CHANGE DT/TM [13D] ^
     123    ; ^DPT(D0,.121)= (#.12114) TEMPORARY ADDRESS CHANGE SITE [14P:4] ^
     124    ; ^DPT(D0,.13)= (#.131) PHONE NUMBER [RESIDENCE] [1F] ^ (#.132) PHONE NUMBER
     125    ; ==>[WORK] [2F] ^ (#.133) EMAIL ADDRESS [3F] ^ (#.134) PHONE NUMBER
     126    ; ==>[CELLULAR] [4F] ^ (#.135) PAGER NUMBER [5F] ^ (#.136) EMAIL
     127    ; ==>ADDRESS CHANGE DT/TM [6D] ^ (#.137) EMAIL ADDRESS CHANGE SOURCE
     128    ; ==>[7S] ^ (#.138) EMAIL ADDRESS CHANGE SITE [8P:4] ^ (#.139)
     129    ; ==>CELLULAR NUMBER CHANGE DT/TM [9D] ^ (#.1311) CELLULAR NUMBER
     130    ; ==>CHANGE SOURCE [10S] ^ (#.13111) CELLULAR NUMBER CHANGE SITE
     131    ; ==>[11P:4] ^ (#.1312) PAGER NUMBER CHANGE DT/TM [12D] ^ (#.1313)
     132    ; ==>PAGER NUMBER CHANGE SOURCE [13S] ^ (#.1314) PAGER NUMBER CHANGE
     133    ; ==>SITE [14P:4] ^
     134    ; ^DPT(D0,.21)= (#.211) K-NAME OF PRIMARY NOK [1F] ^ (#.212) K-RELATIONSHIP TO
     135    ; ==>PATIENT [2F] ^ (#.213) K-STREET ADDRESS [LINE 1] [3F] ^ (#.214)
     136    ; ==>K-STREET ADDRESS [LINE 2] [4F] ^ (#.215) K-STREET ADDRESS [LINE
     137    ; ==>3] [5F] ^
     138    ; ^DPT(D0,.21)= (#.216) K-CITY [6F] ^ (#.217) K-STATE [7P:5] ^ (#.218) K-ZIP
     139    ; ==>CODE [8F] ^ (#.219) K-PHONE NUMBER [9F] ^ (#.2125) K-ADDRESS
     140    ; ==>SAME AS PATIENT'S? [10S] ^ (#.21011) K-WORK PHONE NUMBER [11F]
     141    ; ==>^
     142    ; ^DPT(D0,.211)= (#.2191) K2-NAME OF SECONDARY NOK [1F] ^ (#.2192)
     143    ; ==>K2-RELATIONSHIP TO PATIENT [2F] ^ (#.2193) K2-STREET ADDRESS
     144    ; ==>[LINE 1] [3F] ^ (#.2194) K2-STREET ADDRESS [LINE 2] [4F] ^
     145    ; ==>(#.2195) K2-STREET ADDRESS [LINE 3] [5F] ^ (#.2196) K2-CITY
     146    ; ==>[6F] ^ (#.2197) K2-STATE [7P:5] ^ (#.2198) K2-ZIP CODE [8F] ^
     147    ; ==>(#.2199) K2-PHONE NUMBER [9F] ^ (#.21925) K2-ADDRESS SAME AS
     148    ; ==>PATIENT'S? [10S] ^ (#.211011) K2-WORK PHONE NUMBER [11F] ^
     149    ; ^DPT(D0,.25)= (#.251) SPOUSE'S EMPLOYER NAME [1F] ^ (#.252) SPOUSE'S EMP
     150    ; ==>STREET [LINE 1] [2F] ^ (#.253) SPOUSE'S EMP STREET [LINE 2]
     151    ; ==>[3F] ^ (#.254) SPOUSE'S EMP STREET [LINE 3] [4F] ^ (#.255)
     152    ; ==>SPOUSE'S EMPLOYER'S CITY [5F] ^ (#.256) SPOUSE'S EMPLOYER'S
     153    ; ==>STATE [6P:5] ^ (#.257) SPOUSE'S EMP ZIP CODE [7F] ^ (#.258)
     154    ; ==>SPOUSE'S EMP PHONE NUMBER [8F] ^  ^  ^  ^  ^  ^ (#.2514)
     155    ; ==>SPOUSE'S OCCUPATION [14F] ^ (#.2515) SPOUSE'S EMPLOYMENT STATUS
     156    ; ==>[15S] ^ (#.2516) SPOUSE'S RETIREMENT DATE [16D] ^
     157    ; ^DPT(D0,.33)= (#.331) E-NAME [1F] ^ (#.332) E-RELATIONSHIP TO PATIENT [2F] ^
     158    ; ==>(#.333) E-STREET ADDRESS [LINE 1] [3F] ^ (#.334) E-STREET
     159    ; ==>ADDRESS [LINE 2] [4F] ^ (#.335) E-STREET ADDRESS [LINE 3] [5F]
     160    ; ==>^ (#.336) E-CITY [6F] ^ (#.337) E-STATE [7P:5] ^ (#.338) E-ZIP
     161    ; ==>CODE [8F] ^ (#.339) E-PHONE NUMBER [9F] ^ (#.3305) E-EMER.
     162    ; ==>CONTACT SAME AS NOK? [10S] ^ (#.33011) E-WORK PHONE NUMBER
     163    ; ==>[11F] ^DFN) ; Copy DFN global to a local variable; PUBLIC
     164    ; INPUT: Patient IEN (DFN)
     165    ; OUTPUT: PT in the Symbol Table, representing the patient global
     166    ; Instead of accessing a global each single read (SLOOOOW)
     167    ; read it off a local variable stored in Memory.
     168INIT(DFN) ;
    174169          M PT=^DPT(DFN)
    175170          Q

  • ccr/trunk/p/CCRDPTT.m

    r69 r122  
    11CCRDPTT ; Unit Tester...
     2  ;;0.1;CCRCCD;;Jun 15, 2008;
    23 ;
    34 ;Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
    … …  
    2728          ; STATS(111,0)="MIDDLE() ; Middle Name; PUBLIC; Extrinsic "
    2829          ; etc.
    29 
     30          ;
    3031          ; Load Routine Entry points; We get a sweeeeeet array
    3132          D ANALYZE^ARJTXRD("CCRDPT",.OUT) ; Analyze a routine in the directory
    … …  
    3334          ; Select Patient
    3435          S DIC=2,DIC(0)="AEMQ" D ^DIC
    35 
     36          ;
    3637          W "You have selected patient "_Y,!!
    3738          D INIT^CCRDPT($P(Y,"^"))
    38           ZWR PT
     39          ; ZWR PT
    3940          N I S I=165 F  S I=$O(OUT(I)) Q:I=""  D
    4041          . W "OUT("_I_",0)"_" is "_$P(OUT(I,0)," ")_" "

  • ccr/trunk/p/CCRSYS.m

    r69 r122  
    1919    ;
    2020        W "Enter at appropriate points." Q
    21 
     21        ;
    2222        ; Originally, I was going to use VEPERVER, but VEPERVER
    2323        ; actually kills ^TMP($J), outputs it to the screen in a user-friendly
    2424        ; manner (press any key to continue),
    2525        ; and is really a very half finished routine
    26 
     26        ;
    2727        ; So for now, I am hard-coding the values.
    28 
     28        ;
    2929SYSNAME() ;Get EHR System Name; PUBLIC; Extrinsic
    3030        Q "WorldVistA EHR/VOE"
    … …  
    3333        Q "1.0"
    3434        ;
    35 

  • ccr/trunk/p/CCRUNIT.m

    r101 r122  
    11CCRUNIT ; A routine that tests some crap
    2         Q
    3         ;
     2        ;;0.1;CCDCCR;;JUL 13, 2007;Build 0
     3        Q
     4        ;
    45MEDS
    5         N DEBUG S DEBUG=0
    6         N DFN S DFN=1
    7         K ^TMP($J)
    8         W "Loading CCR Template into T using LOAD^GPLCCR0($NA(^TMP($J,""CCR"")))",!!
    9         N T S T=$NA(^TMP($J,"CCR"))     D LOAD^GPLCCR0(T)
    10         B
    11         N XPATH S XPATH="//ContinuityOfCareRecord/Body/Medications"
    12         W "XPATH is: "_XPATH,!
    13         W "Getting Med Template into INXML using",!
    14         W "QUERY^GPLXPATH(T,XPATH,""INXML"")",!!
    15         N INXML
    16         D QUERY^GPLXPATH(T,XPATH,"INXML")
    17         B
    18         W "Executing EXTRACT^GPLMEDS(""INXML"",DFN,OUTXML)",!
    19         W "OUTXML will be ^TMP($J,""OUT"")",!
    20         N OUTXML S OUTXML=$NA(^TMP($J,"OUT"))
    21         D EXTRACT^GPLMEDS("INXML",DFN,OUTXML)
    22         Q
     6        N DEBUG S DEBUG=0
     7        N DFN S DFN=1
     8        K ^TMP($J)
     9        W "Loading CCR Template into T using LOAD^GPLCCR0($NA(^TMP($J,""CCR"")))",!!
     10        N T S T=$NA(^TMP($J,"CCR"))     D LOAD^GPLCCR0(T)
     11        B
     12        N XPATH S XPATH="//ContinuityOfCareRecord/Body/Medications"
     13        W "XPATH is: "_XPATH,!
     14        W "Getting Med Template into INXML using",!
     15        W "QUERY^GPLXPATH(T,XPATH,""INXML"")",!!
     16        N INXML
     17        D QUERY^GPLXPATH(T,XPATH,"INXML")
     18        B
     19        W "Executing EXTRACT^GPLMEDS(""INXML"",DFN,OUTXML)",!
     20        W "OUTXML will be ^TMP($J,""OUT"")",!
     21        N OUTXML S OUTXML=$NA(^TMP($J,"OUT"))
     22        D EXTRACT^GPLMEDS("INXML",DFN,OUTXML)
     23        Q

  • ccr/trunk/p/CCRUTIL.m

    r121 r122  
    7070          . I DEBUG W "ZTMP=",ZTMP," "
    7171          S V1(0)=ZCNT ; ARRAYS ARE THE SAME SIZE
    72           I DEBUG ZWR V2
    73           I DEBUG ZWR VSRT
     72          ; I DEBUG ZWR V2
     73          ; I DEBUG ZWR VSRT
    7474          N ZD,ZT ; DATA AND TIME ITERATORS
    7575          N ZDONE ; DONE FLAG

  • ccr/trunk/p/CCRVA200.m

    r69 r122  
    2020        ; This routine uses Kernel APIs and Direct Global Access to get
    2121        ; Proivder Data from File 200.
    22 
     22        ;
    2323        ; The Global is VA(200,*)
    24 
     24        ;
    2525FAMILY(DUZ) ; Get Family Name; PUBLIC; EXTRINSIC
    2626        ; INPUT: DUZ (i.e. File 200 IEN) ByVal
    … …  
    7676        ; Uses a Kernel API. Returns -1 if a specialty is not specified
    7777        ;       in file 200.
    78         ; Otherwise, returns IEN^Profession^Specialty^Sub­            specialty^Effect date^Expired date^VA code
     78        ; Otherwise, returns IEN^Profession^Specialty^Sub­specialty^Effect date^Expired date^VA code
    7979        N STR S STR=$$GET^XUA4A72(DUZ)
    8080        Q:+STR<0 ""
    … …  
    9191        ; INPUT: DUZ ByVal
    9292        ; Output: String.
    93 
     93        ;
    9494        ; First, get site number from the institution file.
    9595        ; 1st piece returned by $$SITE^VASITE, which gets the system institution
    9696        N INST S INST=$P($$SITE^VASITE(),U)
    97 
     97        ;
    9898        ; Second, get mailing address
    9999        ; There are two APIs to get the address, one for physical and one for
    … …  
    166166        Q $P(EMAIL,U)
    167167        ;
    168 

  • ccr/trunk/p/GPLACTOR.m

    r112 r122  
    8282     S AMAP=$NA(^TMP($J,"AMAP"))
    8383     K @AMAP
    84          D INIT^CCRDPT(AIEN)
     84     D INIT^CCRDPT(AIEN)
    8585     S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
    8686     S @AMAP@("ACTORGIVENNAME")=$$GIVEN^CCRDPT

  • ccr/trunk/p/GPLCCD.m

    r121 r122  
    8787    ; MAPPING THE PROVIDER ORGANIZATION,AUTHOR,INFORMANT,CUSTODIAN CDA HEADER
    8888    ; FOR NOW, THEY ARE ALL THE SAME AND RESOLVE TO ORGANIZATION
    89     D ORG^GPLACTORS(CCDGLO,DFN,"ACTORPATIENTORGANIZATION","ACTT2") ; MAP ORG
     89    D ORG^GPLACTOR(CCDGLO,DFN,"ACTORPATIENTORGANIZATION","ACTT2") ; MAP ORG
    9090    D CP^GPLXPATH("ACTT2",CCDGLO)
    9191    ;
    … …  
    116116    ; D ACTLST^GPLCCR(CCDGLO,ACTGLO) ; GEN THE ACTOR LIST
    117117    ; D QUERY^GPLXPATH(TGLOBAL,"//ContinuityOfCareRecord/Actors","ACTT")
    118     ; D EXTRACT^GPLACTORS("ACTT",ACTGLO,"ACTT2")
     118    ; D EXTRACT^GPLACTOR("ACTT",ACTGLO,"ACTT2")
    119119    ; D INSINNER^GPLXPATH(CCDGLO,"ACTT2","//ContinuityOfCareRecord/Actors")
    120120    N I,J,DONE S DONE=0
    121     F I=0:0 D  Q:DONE ; DELETE UNTIL ALL EMPTY ELEMENTS ARE GONE
     121    F I=0:0 D  Q:DONE  ; DELETE UNTIL ALL EMPTY ELEMENTS ARE GONE
    122122    . S J=$$TRIM^GPLXPATH(CCDGLO) ; DELETE EMPTY ELEMENTS
    123123    . W "TRIMMED",J,!

  • ccr/trunk/p/GPLCCD1.m

    r85 r122  
    1 GPLCCD0 ; CCDCCR/GPL - CCD TEMPLATE AND ACCESS ROUTINES; 6/7/08
     1GPLCCD1 ; CCDCCR/GPL - CCD TEMPLATE AND ACCESS ROUTINES; 6/7/08
    22 ;;0.1;CCDCCR;nopatch;noreleasedate
    33 ;Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
    … …  
    2626          ; BAT is a string identifying the section
    2727          ; LINE is a test which will evaluate to true or false
    28           ; I '$G(@ZARY) D
    29           . S @ZARY@(0)=0 ; initially there are no elements
    30           . W "GOT HERE LOADING "_LINE,!
     28          ; I '$G(@ZARY) D  ; IF ZARY DOES NOT EXIST '
     29          ; . S @ZARY@(0)=0 ; initially there are no elements
     30          ; . W "GOT HERE LOADING "_LINE,!
    3131          N CNT ; count of array elements
    3232          S CNT=@ZARY@(0) ; contains array count

  • ccr/trunk/p/GPLCCR0.m

    r92 r122  
    2626          ; BAT is a string identifying the section
    2727          ; LINE is a test which will evaluate to true or false
    28           ; I '$G(@ZARY) D
    29           . S @ZARY@(0)=0 ; initially there are no elements
    30           . W "GOT HERE LOADING "_LINE,!
     28          ; I '$G(@ZARY) D  ;
     29          ; . S @ZARY@(0)=0 ; initially there are no elements
     30          ; . W "GOT HERE LOADING "_LINE,!
    3131          N CNT ; count of array elements
    3232          S CNT=@ZARY@(0) ; contains array count

  • ccr/trunk/p/GPLMEDS.m

    r110 r122  
    3232   . S @MEDOUTXML@(0)=0
    3333   . Q
    34    I DEBUG ZWR MEDRSLT
     34   ; I DEBUG ZWR MEDRSLT
    3535   M GPLMEDS=MEDRSLT
    3636   S MEDTVMAP=$NA(^TMP("GPLCCR",$J,"MEDICATIONS"))

  • ccr/trunk/p/GPLPROBS.m

    r121 r122  
    3838          . S @OUTXML@(0)=0
    3939          . ; Q
    40           I DEBUG ZWR RPCRSLT
     40          ; I DEBUG ZWR RPCRSLT
    4141          F J=1:1:RPCRSLT(0)  D  ; FOR EACH PROBLEM IN THE LIST
    4242          . S VMAP=$NA(@TVMAP@(J))

  • ccr/trunk/p/GPLUNIT.m

    r121 r122  
    113113          W !
    114114          W "THE TESTS!",!
    115           I DEBUG ZWR ZTMP
     115          ; I DEBUG ZWR ZTMP
    116116          Q
    117117          ;

  • ccr/trunk/p/GPLVITAL.m

    r121 r122  
    3939          N VSORT,VDATES,VCNT ; ARRAY FOR DATE SORTED VITALS INDEX
    4040          D VITDATES(.VDATES) ; PULL OUT THE DATES INTO AN ARRAY
    41           I DEBUG ZWR VDATES ;DEBUG
     41          ; I DEBUG ZWR VDATES ;DEBUG
    4242          S VCNT=$$SORTDT^CCRUTIL(.VSORT,.VDATES,-1) ; PUT VITALS IN REVERSE
    4343          ; DATE ORDER AND COUNT THEM. VSORT CONTAINS INDIRECT INDEXES ONLY
    … …  
    175175          . . . D INSINNER^GPLXPATH(VITOUTXML,VITARYTMP)
    176176          ; ZWR ^TMP($J,"VITALS",*)
    177           ZWR ^TMP($J,"VITALARYTMP",*) ; SHOW THE RESULTS
     177          ; ZWR ^TMP($J,"VITALARYTMP",*) ; SHOW THE RESULTS
    178178          I DEBUG D PARY^GPLXPATH(VITOUTXML)
    179179          N VITTMP,I
    … …  
    183183          . F I=1:1:VITTMP(0) W VITTMP(I),!
    184184          Q
    185           ;
    186 VITSORT(V1,V2) ; DEPRECATED USE $$RSORTDT^CCRUTIL
    187                ; DATE SORT VITALS ARRAY AND RETURN INDEX IN V1 AND COUNT
    188                ; AS EXTRINSIC
    189                ; BOTH V1 AND V2 ARE PASSED BY REFERENCE
    190           N VSRT ; TEMP FOR HASHING DATES
    191           N ZI,ZJ,ZTMP,ZCNT,ZP1,ZP2
    192           S ZCNT=0 ; COUNTING NUMBER OF VITALS
    193           S ZTMP="" ;
    194           F ZI=0:0 D  Q:$O(V2(ZTMP))=""  ; FOR EACH VITAL IN THE ARRAY
    195           . S ZCNT=ZCNT+1 ; INCREMENT THE COUNT
    196           . S ZTMP=$O(V2(ZTMP)) ; NEXT VITAL
    197           . I $D(V2(ZTMP)) D  ; IF THE RESULT EXISTS
    198           . . S ZP1=$P($P(V2(ZTMP),U,4),".",1) ; THE DATE PIECE
    199           . . S ZP2=$P($P(V2(ZTMP),U,4),".",2) ; THE TIME PIECE
    200           . . S VSRT(ZP1,ZP2_"00000"_ZCNT)=ZCNT ; HASH ON DATE AND TIME
    201           . . ; S VSRT($P(V2(ZTMP),U,4)_"000000"_ZCNT)=ZCNT ; PULL DATE
    202           . I DEBUG W "ZTMP=",ZTMP," "
    203           S V1(0)=ZCNT ; ARRAYS ARE THE SAME SIZE
    204           I DEBUG ZWR V2
    205           I DEBUG ZWR VSRT
    206           N ZD,ZT ; DATA AND TIME ITERATORS
    207           N ZDONE ; DONE FLAG
    208           S (ZD,ZT)=""
    209           S ZDONE=0
    210           N ZZCNT S ZZCNT=0 ; ANOTHER COUNTER
    211           F ZI=0:0 D  Q:ZDONE  ; VISIT THE ARRAY IN DATE ORDER
    212           . S ZD=$O(VSRT(ZD),-1) ; NEXT DATE
    213           . I ZD="" S ZDONE=1
    214           . I 'ZDONE D  ; MORE DATES
    215           . . S ZT="" ; WANT FIRST TIME FOR THIS DATE
    216           . . F ZJ=0:0 D  Q:$O(VSRT(ZD,ZT),-1)=""  ; LOOP THROUGH ALL TIMES
    217           . . . S ZT=$O(VSRT(ZD,ZT),-1) ; NEXT TIME
    218           . . . S ZZCNT=ZZCNT+1 ; INCREMENT COUNTER
    219           . . . S V1(ZZCNT)=VSRT(ZD,ZT) ; PULL OUT THE INDEX
    220           . ; S V1(ZI)=ZI ; PLUG FOR NOW, DATES NOT SORTED
    221           I DEBUG ZWR V1
    222           Q ZCNT
    223185          ;
    224186VITDATES(VDT) ; VDT IS PASSED BY REFERENCE AND WILL CONTAIN THE ARRAY
Note: See TracChangeset for help on using the changeset viewer.