iSharkFly-Open
/
VistA-ccr
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Updated CCRDPT.

This commit is contained in:
sam 2008-06-25 04:15:14 +00:00
parent df4a79e484
commit 555f3ac4f3
1 changed files with 82 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

85
p/CCRDPT.m
View File

@ -159,7 +159,7 @@ CITY() ; Get City for Home Address; PUBLIC; Extrinsic
STATE() ; Get State for Home Address; PUBLIC; Extrinsic
; PREREQ: PT Defined
; State is stored as a pointer
N STATENUM=$P(PT(.11)"^",5)
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
@ -167,11 +167,90 @@ STATE() ; Get State for Home Address; PUBLIC; Extrinsic
; ==>US STATE OR POSSESSION [6S] ^
Q $P(^DIC(5,STATENUM,0),"^",1)
;
ZIP() ; Get Zip code for Home Address
ZIP() ; Get Zip code for Home Address; PUBLIC; Extrinsic
; PREREQ: PT Defined
Q $P(PT(.11),"^",6)
;
COUNTY() ; Get County for our Address
COUNTY() ; Get County for our Address; PUBLIC; Extrinsic
; PREREQ: PT Defined
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 "USA"
;
RESTEL() ; Residential Telephone; PUBLIC; Extrinsic
; PREREQ: PT Defined
Q $P(PT(.13),"^",1)
;
WORKTEL() ; Work Telephone; PUBLIC; Extrinsic
; PREREQ: PT Defined
Q $P(PT(.13),"^",2)
;
EMAIL() ; Email Adddress; PUBLIC; Extrinsic
; PREREQ: PT Defined
Q $P(PT(.13),"^",3)
;
CELLTEL() ; Cell Phone; PUBLIC; Extrinsic
; PREREQ: PT Defined
Q $P(PT(.13),"^",4)
;
NOK1FAM() ; Next of Kin 1 (NOK1) Family Name; PUBLIC; Extrinsic
; PREREQ: PT Defined
N NAME S NAME=$P(PT(.21),"^",1)
D NAMECOMP^XLFNAME(.NAME)
Q NAME("FAMILY")
;
NOK1GIV() ; NOK1 Given Name; PUBLIC; Extrinsic
; PREREQ: PT Defined
N NAME S NAME=$P(PT(.21),"^",1)
D NAMECOMP^XLFNAME(.NAME)
Q NAME("GIVEN")
;
NOK1MID() ; NOK1 Middle Name; PUBLIC; Extrinsic
; PREREQ: PT Defined
N NAME S NAME=$P(PT(.21),"^",1)
D NAMECOMP^XLFNAME(.NAME)
Q NAME("MIDDLE")
;
NOK1SUF() ; NOK1 Suffi Name; PUBLIC; Extrinsic
; PREREQ: PT Defined
N NAME S NAME=$P(PT(.21),"^",1)
D NAMECOMP^XLFNAME(.NAME)
Q NAME("SUFFIX")
;
NOK1DISP() ; NOK1 Display Name; PUBLIC; Extrinsic
; PREREQ: PT Defined
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
NOK2FAM() ; NOK2 Family Name; PUBLIC; Extrinsic
; PREREQ: PT Defined
N NAME S NAME=$P(PT(.211),"^",1)
D NAMECOMP^XLFNAME(.NAME)
Q NAME("FAMILY")
;
NOK2GIV() ; NOK2 Given Name; PUBLIC; Extrinsic
; PREREQ: PT Defined
N NAME S NAME=$P(PT(.211),"^",1)
D NAMECOMP^XLFNAME(.NAME)
Q NAME("GIVEN")
;
NOK2MID() ; NOK2 Middle Name; PUBLIC; Extrinsic
; PREREQ: PT Defined
N NAME S NAME=$P(PT(.211),"^",1)
D NAMECOMP^XLFNAME(.NAME)
Q NAME("MIDDLE")
;
NOK2SUF() ; NOK2 Suffi Name; PUBLIC; Extrinsic
; PREREQ: PT Defined
N NAME S NAME=$P(PT(.211),"^",1)
D NAMECOMP^XLFNAME(.NAME)
Q NAME("SUFFIX")
;
NOK2DISP() ; NOK2 Display Name; PUBLIC; Extrinsic
; PREREQ: PT Defined
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