Changes in ccr/trunk/p/CCRDPT.m [26:14]

File:

• ccr/trunk/p/CCRDPT.m (modified) (10 diffs)

ccr/trunk/p/CCRDPT.m

@@ -4 +4 @@
         ;       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
@@ -167 +99 @@
 FAMILY() ; Family Name; PUBLIC; Extrinsic
         ; PREREQ: PT Defined
-        Q:$G(PT(0))="" ""
         N NAME S NAME=$P(PT(0),"^",1)
         D NAMECOMP^XLFNAME(.NAME)
@@ -174 +105 @@
 GIVEN() ; Given Name; PUBLIC; Extrinsic
         ; PREREQ: PT Defined
-        Q:$G(PT(0))="" ""
         N NAME S NAME=$P(PT(0),"^",1)
         D NAMECOMP^XLFNAME(.NAME)
@@ -181 +111 @@
 MIDDLE() ; Middle Name; PUBLIC; Extrinsic 
         ; PREREQ: PT Defined
-        Q:$G(PT(0))="" ""
         N NAME S NAME=$P(PT(0),"^",1)
         D NAMECOMP^XLFNAME(.NAME)
@@ -188 +117 @@
 SUFFIX() ; Suffi Name; PUBLIC; Extrinsic
         ; PREREQ: PT Defined
-        Q:$G(PT(0))="" ""
         N NAME S NAME=$P(PT(0),"^",1)
         D NAMECOMP^XLFNAME(.NAME)
@@ -195 +123 @@
 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") 
@@ -201 +128 @@
 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.
@@ -208 +134 @@
 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
+ADDRTYPE(ADDR) ; 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)
         ;
@@ -229 +151 @@
         ; 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)
+        N STATENUM=$P(PT(.11)"^",5)
         ;
         ; State File Global is below
@@ -251 +166 @@
     ; ==>[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
+ZIP() ; Get Zip code for Home Address
         ; PREREQ: PT Defined
-        Q:$G(PT(.11))="" ""
         Q $P(PT(.11),"^",6)
         ;
-COUNTY() ; Get County for our Address; PUBLIC; Extrinsic
+COUNTY() ; Get County for our Address
         ; 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)
-        ;