Index: /ccr/trunk/p/CCRDPT.m
===================================================================
--- /ccr/trunk/p/CCRDPT.m	(revision 20)
+++ /ccr/trunk/p/CCRDPT.m	(revision 30)
@@ -4,4 +4,72 @@
 	;	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
@@ -99,4 +167,5 @@
 FAMILY() ; Family Name; PUBLIC; Extrinsic
 	; PREREQ: PT Defined
+	Q:$G(PT(0))="" ""
 	N NAME S NAME=$P(PT(0),"^",1)
 	D NAMECOMP^XLFNAME(.NAME)
@@ -105,4 +174,5 @@
 GIVEN() ; Given Name; PUBLIC; Extrinsic
 	; PREREQ: PT Defined
+	Q:$G(PT(0))="" ""
 	N NAME S NAME=$P(PT(0),"^",1)
 	D NAMECOMP^XLFNAME(.NAME)
@@ -111,4 +181,5 @@
 MIDDLE() ; Middle Name; PUBLIC; Extrinsic 
 	; PREREQ: PT Defined
+	Q:$G(PT(0))="" ""
 	N NAME S NAME=$P(PT(0),"^",1)
 	D NAMECOMP^XLFNAME(.NAME)
@@ -117,4 +188,5 @@
 SUFFIX() ; Suffi Name; PUBLIC; Extrinsic
 	; PREREQ: PT Defined
+	Q:$G(PT(0))="" ""
 	N NAME S NAME=$P(PT(0),"^",1)
 	D NAMECOMP^XLFNAME(.NAME)
@@ -123,4 +195,5 @@
 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") 
@@ -128,4 +201,5 @@
 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.
@@ -134,16 +208,20 @@
 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(ADDR) ; Get Home Address; PUBLIC; Extrinsic
+ADDRTYPE() ; Get Home Address; PUBLIC; Extrinsic
 	; Vista only stores a home address for the patient.
+	Q:$G(PT(0))="" ""
 	Q "Home"
 	;
 ADDR1() ; Get Home Address line 1; PUBLIC; Extrinsic
 	; PREREQ: PT Defined
+	Q:$G(PT(.11))="" ""
 	Q $P(PT(.11),"^",1)
 	;
@@ -151,14 +229,21 @@
 	; 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=$P(PT(.11)"^",5)
+	N STATENUM S STATENUM=$P(PT(.11),"^",5)
 	;
 	; State File Global is below
@@ -166,12 +251,295 @@
     ; ==>[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
-	; PREREQ: PT Defined
+ZIP() ; Get Zip code for Home Address; PUBLIC; Extrinsic
+	; PREREQ: PT Defined
+	Q:$G(PT(.11))="" ""
 	Q $P(PT(.11),"^",6)
 	;
-COUNTY() ; Get County for our Address
-	; PREREQ: PT Defined
+COUNTY() ; Get County for our Address; PUBLIC; Extrinsic
+	; PREREQ: PT Defined
+	Q:$G(PT(.11))="" ""
 	Q $P(PT(.11),"^",7)
 	;
+COUNTRY() ; Get Country for our Address; PUBLIC; Extrinsic
+	; Unfortunately, I can't find where that is stored, so the inevitable...
+	Q:$G(PT(.11))="" ""
+	Q "USA"
+	;
+RESTEL() ; Residential Telephone; PUBLIC; Extrinsic
+	; PREREQ: PT Defined
+	Q:$G(PT(.13))="" ""
+	Q $P(PT(.13),"^",1)
+	;
+WORKTEL() ; Work Telephone; PUBLIC; Extrinsic
+	; PREREQ: PT Defined
+	Q:$G(PT(.13))="" ""
+	Q $P(PT(.13),"^",2)
+	;
+EMAIL() ; Email Adddress; PUBLIC; Extrinsic
+	; PREREQ: PT Defined
+	Q:$G(PT(.13))="" ""
+	Q $P(PT(.13),"^",3)
+	;
+CELLTEL() ; Cell Phone; PUBLIC; Extrinsic
+	; PREREQ: PT Defined
+	Q:$G(PT(.13))="" ""
+	Q $P(PT(.13),"^",4)
+	;
+NOK1FAM() ; Next of Kin 1 (NOK1) Family Name; PUBLIC; Extrinsic
+	; PREREQ: PT Defined
+	Q:$G(PT(.21))="" ""
+	N NAME S NAME=$P(PT(.21),"^",1)
+	D NAMECOMP^XLFNAME(.NAME)
+	Q NAME("FAMILY")
+	;
+NOK1GIV() ; NOK1 Given Name; PUBLIC; Extrinsic
+	; PREREQ: PT Defined
+	Q:$G(PT(.21))="" ""
+	N NAME S NAME=$P(PT(.21),"^",1)
+	D NAMECOMP^XLFNAME(.NAME)
+	Q NAME("GIVEN")
+	;
+NOK1MID() ; NOK1 Middle Name; PUBLIC; Extrinsic 
+	; PREREQ: PT Defined
+	Q:$G(PT(.21))="" ""
+	N NAME S NAME=$P(PT(.21),"^",1)
+	D NAMECOMP^XLFNAME(.NAME)
+	Q NAME("MIDDLE")
+	;
+NOK1SUF() ; NOK1 Suffi Name; PUBLIC; Extrinsic
+	; PREREQ: PT Defined
+	Q:$G(PT(.21))="" ""
+	N NAME S NAME=$P(PT(.21),"^",1)
+	D NAMECOMP^XLFNAME(.NAME)
+	Q NAME("SUFFIX") 
+	;
+NOK1DISP() ; NOK1 Display Name; PUBLIC; Extrinsic
+	; PREREQ: PT Defined
+	Q:$G(PT(.21))="" ""
+	N NAME S NAME=$P(PT(.21),"^",1)
+	Q $$NAMEFMT^XLFNAME(.NAME,"G","MXc") 
+	; "G" is Given Name First; "MXc" is Mixed Case, With Suffx Preceded by Comma
+NOK1REL() ; NOK1 Relationship to the patient; PUBLIC; Extrinsic
+	; PREREQ: PT Defined
+	Q:$G(PT(.21))="" ""
+	Q $P(PT(.21),"^",2)
+	;
+NOK1ADD1() ; NOK1 Address 1; PUBLIC; Extrinsic
+	; PREREQ: PT Defined
+	Q:$G(PT(.21))="" ""
+	Q $P(PT(.21),"^",3)
+	;
+NOK1ADD2() ; NOK1 Address 2; PUBLIC; Extrinsic
+	; PREREQ: PT Defined
+	; As before, CCR only allows two fileds for the address, so we have to compromise
+	Q:$G(PT(.21))="" ""
+	; If the thrid address is empty, just return the 2nd.
+	; If the 2nd is empty, we don't lose, b/c it will return ""
+	; This is so that we won't produce a comma if there is no 3rd addr.
+	Q:$P(PT(.21),"^",5)="" $P(PT(.21),"^",4)
+	Q $P(PT(.21),"^",4)_", "_$P(PT(.21),"^",5)
+	;
+NOK1CITY() ; NOK1 City; PUBLIC; Extrinsic
+	; PREREQ: PT Defined
+	Q:$G(PT(.21))="" ""
+	Q $P(PT(.21),"^",6)
+	;
+NOK1STAT() ; NOK1 State; PUBLIC; Extrinsic
+	; PREREQ: PT Defined
+	Q:$G(PT(.21))="" ""
+	N STATENUM S STATENUM=$P(PT(.21),"^",7)
+	Q:STATENUM="" ""
+	Q $P(^DIC(5,STATENUM,0),"^",1)
+	;
+NOK1ZIP() ; NOK1 Zip Code; PUBLIC; Extrinsic
+	; PREREQ: PT Defined
+	Q:$G(PT(.21))="" ""
+	Q $P(PT(.21),"^",8)
+	;
+NOK1HTEL() ; NOK1 Home Telephone; PUBLIC; Extrinsic
+	; PREREQ: PT Defined
+	Q:$G(PT(.21))="" ""
+	Q $P(PT(.21),"^",9)
+	;
+NOK1WTEL() ; NOK1 Work Telephone; PUBLIC; Extrinsic
+	; PREREQ: PT Defined
+	Q:$G(PT(.21))="" ""
+	Q $P(PT(.21),"^",11)
+	;
+NOK1SAME() ; Is NOK1's Address the same the patient?; PUBLIC; Extrinsic
+	; PREREQ: PT Defined
+	Q:$G(PT(.21))="" ""
+	Q $P(PT(.21),"^",10)
+	;
+NOK2FAM() ; NOK2 Family Name; PUBLIC; Extrinsic
+	; PREREQ: PT Defined
+	Q:$G(PT(.211))="" ""
+	N NAME S NAME=$P(PT(.211),"^",1)
+	D NAMECOMP^XLFNAME(.NAME)
+	Q NAME("FAMILY")
+	;
+NOK2GIV() ; NOK2 Given Name; PUBLIC; Extrinsic ; PREREQ: PT Defined
+	Q:$G(PT(.211))="" ""
+	N NAME S NAME=$P(PT(.211),"^",1)
+	D NAMECOMP^XLFNAME(.NAME)
+	Q NAME("GIVEN")
+	;
+NOK2MID() ; NOK2 Middle Name; PUBLIC; Extrinsic 
+	; PREREQ: PT Defined
+	Q:$G(PT(.211))="" ""
+	N NAME S NAME=$P(PT(.211),"^",1)
+	D NAMECOMP^XLFNAME(.NAME)
+	Q NAME("MIDDLE")
+	;
+NOK2SUF() ; NOK2 Suffi Name; PUBLIC; Extrinsic
+	; PREREQ: PT Defined
+	Q:$G(PT(.211))="" ""
+	N NAME S NAME=$P(PT(.211),"^",1)
+	D NAMECOMP^XLFNAME(.NAME)
+	Q NAME("SUFFIX") 
+NOK2DISP() ; NOK2 Display Name; PUBLIC; Extrinsic
+	; PREREQ: PT Defined
+	Q:$G(PT(.211))="" ""
+	N NAME S NAME=$P(PT(.211),"^",1)
+	Q $$NAMEFMT^XLFNAME(.NAME,"G","MXc") 
+	; "G" is Given Name First; "MXc" is Mixed Case, With Suffx Preceded by Comma
+NOK2REL() ; NOK2 Relationship to the patient; PUBLIC; Extrinsic
+	; PREREQ: PT Defined
+	Q:$G(PT(.211))="" ""
+	Q $P(PT(.211),"^",2)
+	;
+NOK2ADD1() ; NOK2 Address 1; PUBLIC; Extrinsic
+	; PREREQ: PT Defined
+	Q:$G(PT(.211))="" ""
+	Q $P(PT(.211),"^",3)
+	;
+NOK2ADD2() ; NOK2 Address 2; PUBLIC; Extrinsic
+	; PREREQ: PT Defined
+	; As before, CCR only allows two fileds for the address, so we have to compromise
+	Q:$G(PT(.211))="" ""
+	; If the thrid address is empty, just return the 2nd.
+	; If the 2nd is empty, we don't lose, b/c it will return ""
+	; This is so that we won't produce a comma if there is no 3rd addr.
+	Q:$P(PT(.211),"^",5)="" $P(PT(.211),"^",4)
+	Q $P(PT(.211),"^",4)_", "_$P(PT(.211),"^",5)
+	;
+NOK2CITY() ; NOK2 City; PUBLIC; Extrinsic
+	; PREREQ: PT Defined
+	Q:$G(PT(.211))="" ""
+	Q $P(PT(.211),"^",6)
+	;
+NOK2STAT() ; NOK2 State; PUBLIC; Extrinsic
+	; PREREQ: PT Defined
+	Q:$G(PT(.211))="" ""
+	N STATENUM S STATENUM=$P(PT(.211),"^",7)
+	Q:STATENUM="" ""  ; To prevent global undefined below if no state
+	Q $P(^DIC(5,STATENUM,0),"^",1) ; Explained above
+	;
+NOK2ZIP() ; NOK2 Zip Code; PUBLIC; Extrinsic
+	; PREREQ: PT Defined
+	Q:$G(PT(.211))="" ""
+	Q $P(PT(.211),"^",8)
+	;
+NOK2HTEL() ; NOK2 Home Telephone; PUBLIC; Extrinsic
+	; PREREQ: PT Defined
+	Q:$G(PT(.211))="" ""
+	Q $P(PT(.211),"^",9)
+	;
+NOK2WTEL() ; NOK2 Work Telephone; PUBLIC; Extrinsic
+	; PREREQ: PT Defined
+	Q:$G(PT(.211))="" ""
+	Q $P(PT(.211),"^",11)
+	;
+NOK2SAME() ; Is NOK2's Address the same the patient?; PUBLIC; Extrinsic
+	; PREREQ: PT Defined 
+	Q:$G(PT(.211))="" ""
+	Q $P(PT(.211),"^",10)
+	; 
+EMERFAM() ; Emergency Contact (EMER) Family Name; PUBLIC; Extrinsic
+	; PREREQ: PT Defined
+	Q:$G(PT(.33))="" ""
+	N NAME S NAME=$P(PT(.33),"^",1)
+	D NAMECOMP^XLFNAME(.NAME)
+	Q NAME("FAMILY")
+	;
+EMERGIV() ; EMER Given Name; PUBLIC; Extrinsic
+	; PREREQ: PT Defined
+	Q:$G(PT(.33))="" ""
+	N NAME S NAME=$P(PT(.33),"^",1)
+	D NAMECOMP^XLFNAME(.NAME)
+	Q NAME("GIVEN")
+	;
+EMERMID() ; EMER Middle Name; PUBLIC; Extrinsic 
+	; PREREQ: PT Defined
+	Q:$G(PT(.33))="" ""
+	N NAME S NAME=$P(PT(.33),"^",1)
+	D NAMECOMP^XLFNAME(.NAME)
+	Q NAME("MIDDLE")
+	;
+EMERSUF() ; EMER Suffi Name; PUBLIC; Extrinsic
+	; PREREQ: PT Defined
+	Q:$G(PT(.33))="" ""
+	N NAME S NAME=$P(PT(.33),"^",1)
+	D NAMECOMP^XLFNAME(.NAME)
+	Q NAME("SUFFIX") 
+EMERDISP() ; EMER Display Name; PUBLIC; Extrinsic
+	; PREREQ: PT Defined
+	Q:$G(PT(.33))="" ""
+	N NAME S NAME=$P(PT(.33),"^",1)
+	Q $$NAMEFMT^XLFNAME(.NAME,"G","MXc") 
+	; "G" is Given Name First; "MXc" is Mixed Case, With Suffx Preceded by Comma
+EMERREL() ; EMER Relationship to the patient; PUBLIC; Extrinsic
+	; PREREQ: PT Defined
+	Q:$G(PT(.33))="" ""
+	Q $P(PT(.33),"^",2)
+	;
+EMERADD1() ; EMER Address 1; PUBLIC; Extrinsic
+	; PREREQ: PT Defined
+	Q:$G(PT(.33))="" ""
+	Q $P(PT(.33),"^",3)
+	;
+EMERADD2() ; EMER Address 2; PUBLIC; Extrinsic
+	; PREREQ: PT Defined
+	; As before, CCR only allows two fileds for the address, so we have to compromise
+	Q:$G(PT(.33))="" ""
+	; If the thrid address is empty, just return the 2nd.
+	; If the 2nd is empty, we don't lose, b/c it will return ""
+	; This is so that we won't produce a comma if there is no 3rd addr.
+	Q:$P(PT(.33),"^",5)="" $P(PT(.33),"^",4)
+	Q $P(PT(.33),"^",4)_", "_$P(PT(.33),"^",5)
+	;
+EMERCITY() ; EMER City; PUBLIC; Extrinsic
+	; PREREQ: PT Defined
+	Q:$G(PT(.33))="" ""
+	Q $P(PT(.33),"^",6)
+	;
+EMERSTAT() ; EMER State; PUBLIC; Extrinsic
+	; PREREQ: PT Defined
+	Q:$G(PT(.33))="" ""
+	N STATENUM S STATENUM=$P(PT(.33),"^",7)
+	Q:STATENUM="" ""  ; To prevent global undefined below if no state
+	Q $P(^DIC(5,STATENUM,0),"^",1) ; Explained above
+	;
+EMERZIP() ; EMER Zip Code; PUBLIC; Extrinsic
+	; PREREQ: PT Defined
+	Q:$G(PT(.33))="" ""
+	Q $P(PT(.33),"^",8)
+	;
+EMERHTEL() ; EMER Home Telephone; PUBLIC; Extrinsic
+	; PREREQ: PT Defined
+	Q:$G(PT(.33))="" ""
+	Q $P(PT(.33),"^",9)
+	;
+EMERWTEL() ; EMER Work Telephone; PUBLIC; Extrinsic
+	; PREREQ: PT Defined
+	Q:$G(PT(.33))="" ""
+	Q $P(PT(.33),"^",11)
+	;
+EMERSAME() ; Is EMER's Address the same the NOK?; PUBLIC; Extrinsic
+	; PREREQ: PT Defined 
+	Q:$G(PT(.33))="" ""
+	Q $P(PT(.33),"^",10)
+	; 
Index: /ccr/trunk/p/CCRDPTT.m
===================================================================
--- /ccr/trunk/p/CCRDPTT.m	(revision 30)
+++ /ccr/trunk/p/CCRDPTT.m	(revision 30)
@@ -0,0 +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
+
+	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/GPLCCR.m
===================================================================
--- /ccr/trunk/p/GPLCCR.m	(revision 20)
+++ /ccr/trunk/p/GPLCCR.m	(revision 30)
@@ -7,4 +7,5 @@
         ; Select a patient for real.
         S DIC=2,DIC(0)="AEMQ" D ^DIC
+        I Y<1 Q ; EXIT
         S DFN=$P(Y,U,1) ; SET THE PATIENT
         N CCRGLO
@@ -12,5 +13,5 @@
         S OARY=$NA(^TMP($J,DFN,"CCR",1))
         S ONAM="PAT_"_DFN_"_CCR_V1.xml"
-        S ODIR="/home/wvehr1/EHR/CCR"
+        S ODIR="/home/glilly/CCROUT"
         D OUTPUT^GPLXPATH(OARY,ONAM,ODIR)
         Q
@@ -20,4 +21,5 @@
         S TGLOBAL=$NA(^TMP($J,"TEMPLATE")) ; GLOBAL FOR STORING TEMPLATE
         S CCRGLO=$NA(^TMP($J,DFN,"CCR")) ; GLOBAL FOR BUILDING THE CCR
+        S ACTGLO=$NA(^TMP($J,DFN,"ACTORS")); GLOBAL FOR ALL ACTORS IN CCR
         ; TO GET PART OF THE CCR RETURNED, PASS CCRPART="PROBLEMS" ETC
         S CCRGRTN=$NA(^TMP($J,DFN,CCRPART)) ; RTN GLO NM OF PART OR ALL OF CCR
@@ -26,10 +28,11 @@
         ;
         ; DELETE THE BODY, ACTORS AND SIGNATURES SECTIONS FROM THE CCR GLOBAL
-        ; THESE WILL BE POPULATED WITH CALLS TO THE XPATH PROCESSING ROUTINES
+        ; THESE WILL BE POPULATED AFTER CALLS TO THE XPATH PROCESSING ROUTINES
         D REPLACE^GPLXPATH(CCRGLO,"","//ContinuityOfCareRecord/Body")
         D REPLACE^GPLXPATH(CCRGLO,"","//ContinuityOfCareRecord/Actors")
         D REPLACE^GPLXPATH(CCRGLO,"","//ContinuityOfCareRecord/Signatures")
-        F I=1:1:@CCRGLO@(0) W @CCRGLO@(I),!
+        I DEBUG F I=1:1:@CCRGLO@(0) W @CCRGLO@(I),!
         ;
+        D CCRHDR(CCRGLO,DFN) ; MAP HEADER VARIABLES
         S CCRXTAB="^TMP($J,""CCRSTEP"")" ; GLOBAL TO STORE CCR PROCESSING STEPS
         D INITSTPS(CCRXTAB) ; INITIALIZED CCR PROCESSING STEPS
@@ -48,14 +51,7 @@
         . X CALL
         . ; NOW INSERT THE RESULTS IN THE CCR BUFFER
-        . ; D INSERT^GPLXPATH(CCRGLO,OXML,"//ContinuityOfCareRecord/Body")
+        . D INSERT^GPLXPATH(CCRGLO,OXML,"//ContinuityOfCareRecord/Body")
         . I DEBUG F GPLI=1:1:@OXML@(0) W @OXML@(GPLI),!
-        . D QOPEN^GPLXPATH("CCRBLD",CCRGLO,"//ContinuityOfCareRecord/Body")
-        . D QUEUE^GPLXPATH("CCRBLD",OXML,1,@OXML@(0))
-        . D QCLOSE^GPLXPATH("CCRBLD",CCRGLO,"//ContinuityOfCareRecord/Body")
-        . I DEBUG W "GOING TO BUILD CCR",!
-        . N CCRTMP
-        . D BUILD^GPLXPATH("CCRBLD","CCRTMP")
-        . I DEBUG F GPLI=1:1:CCRTMP(0) W CCRTMP(GPLI),!
-        . D CP^GPLXPATH("CCRTMP",CCRGLO)
+        . D ACTLST^GPLCCR(CCRGLO,ACTGLO)
         Q
         ;
@@ -67,11 +63,37 @@
         Q
          ;
+CCRHDR(CXML,DFN) ; MAP HEADER VARIABLES: FROM, TO ECT
+        N VMAP S VMAP=$NA(^TMP($J,DFN,"HEADER"))
+        ; K @VMAP
+        S @VMAP@("ACTORPATIENT")="ACTORPATIENT_"_DFN
+        S @VMAP@("ACTORFROM")="ACTORPROVIDER_"_DUZ ; FROM DUZ - ???
+        S @VMAP@("ACTORFROM2")="ACTORPROVIDER_"_DUZ ; NEED A BETTER WAY
+        S @VMAP@("ACTORTO")="ACTORPATIENT_"_DFN  ; FOR TEST PURPOSES,
+        ; THIS IS THE USE CASE FOR THE PHR WHERE "TO" IS THE PATIENT
+        N CTMP
+        D MAP^GPLXPATH(CXML,VMAP,"CTMP")
+        D CP^GPLXPATH("CTMP",CXML)
+        Q
+        ;
+ACTLST(AXML,ACTRTN) ; RETURN THE ACTOR LIST FOR THE XML IN AXML
+        ; AXML AND ACTRTN ARE PASSED BY NAME
+        N I,J,K
+        K @ACTRTN ; CLEAR RETURN ARRAY
+        F I=1:1:@AXML@(0) D  ; SCAN ALL LINES
+        . I @AXML@(I)?.E1"<ActorID>".E D  ; THERE IS AN ACTOR ON THIS LINE
+        . . S J=$P($P(@AXML@(I),"<ActorID>",2),"</ActorID>",1)
+        . . W "<ActorID>=>",J,!
+        . . S K(J)="" ; HASHING ACTOR TO GET RID OF MULTIPLES
+        S I="" ; GOING TO $O THROUGH THE HASH
+        F J=0:0 D  Q:$O(K(I))=""
+        . S I=$O(K(I)) ; WALK THROUGH THE HASH OF ACTORS
+        . D PUSH^GPLXPATH(ACTRTN,I) ; ADD THE ACTOR TO THE RETURN ARRAY
+        Q
+        ;
 TEST   ; RUN ALL THE TEST CASES
-      N ZTMP
-      D ZLOAD^GPLUNIT("ZTMP","GPLCCR")
-      D ZTEST^GPLUNIT(.ZTMP,"ALL")
-      W !
-      ; W "THE TESTS!",!
-      ; ZWR ZTMP
+      ;D TESTALL^GPLUNIT("GPLCCR")
+      D ZTEST^GPLCCR("PROBLEMS")
+      W "TESTING RETURNED FROM PROBLMES",!
+      D ZTEST^GPLCCR("CCR")
       Q
       ;
@@ -89,5 +111,15 @@
       ;
 ;;><TEST>
-;;><INIT>
+;;><PROBLEMS>
 ;;>>>K GPL S GPL=""
+;;>>>D CCRRPC^GPLCCR(.GPL,"2","PROBLEMS")
+;;>>?@GPL@(@GPL@(0))="</Problems>"
+;;><CCR>
+;;>>>K GPL S GPL=""
+;;>>>D CCRRPC^GPLCCR(.GPL,"2","CCR")
+;;>>?@GPL@(@GPL@(0))="</ContinutiyOfCareRecord>"
+;;><ACTLST>
+;;>>>N TCCR
+;;>>>D CCRRPC^GPLCCR(.TCCR,"2","CCR")
+;;>>>D ACTLST^GPLCCR("TCCR","ACTTEST")
 ;;></TEST>
Index: /ccr/trunk/p/GPLCCR0.m
===================================================================
--- /ccr/trunk/p/GPLCCR0.m	(revision 20)
+++ /ccr/trunk/p/GPLCCR0.m	(revision 30)
@@ -47,4 +47,5 @@
 ;<TEMPLATE>
 ;;<?xml version="1.0" encoding="UTF-8"?>
+;;<?xml-stylesheet type="text/xsl" href="ccr_20060420.xsl"?>
 ;;<ContinuityOfCareRecord xmlns="urn:astm-org:CCR">
 ;;<CCRDocumentObjectID>871bd605-e8f8-4b80-9918-4b03f781129e</CCRDocumentObjectID>
@@ -91,6 +92,6 @@
 ;;<Code>
 ;;<Value>@@PROBLEMCODEVALUE@@</Value>
-;;<CodingSystem>@@PROBLEMCODINGSYSTEM@@ICD9CM</CodingSystem>
-;;<Version>@@PROBLEMCODINGVERSION@@2007</Version>
+;;<CodingSystem>ICD9CM</CodingSystem>
+;;<Version>@@PROBLEMCODINGVERSION@@</Version>
 ;;</Code>
 ;;</Description>
Index: /ccr/trunk/p/GPLPROBS.m
===================================================================
--- /ccr/trunk/p/GPLPROBS.m	(revision 20)
+++ /ccr/trunk/p/GPLPROBS.m	(revision 30)
@@ -15,5 +15,5 @@
     D LIST^ORQQPL3(.RPCRSLT,DFN,"") ; CALL THE PROBLEM LIST RPC
     I '$D(RPCRSLT(0)) W "ERROR CALLING LIST^ORQQPL3 ",! Q
-    I DEBUG ZWR RPCRSLT
+    ZWR RPCRSLT
     S TVMAP=$NA(^TMP($J,"PROBVALS"))
     S TARYTMP=$NA(^TMP($J,"PROBARYTMP"))
Index: /ccr/trunk/p/GPLUNIT.m
===================================================================
--- /ccr/trunk/p/GPLUNIT.m	(revision 20)
+++ /ccr/trunk/p/GPLUNIT.m	(revision 30)
@@ -17,5 +17,5 @@
         S ZARY(CNT)=TST ; put the test in the array
         I $D(ZARY(BAT))  D  ; NOT THE FIRST TEST IN BATTERY
-        . N II ; TEMP FOR ENDING TEST IN BATTERY
+        . N II,TN ; TEMP FOR ENDING TEST IN BATTERY
         . S II=$P(ZARY(BAT),"^",2)
         . S $P(ZARY(BAT),"^",2)=II+1
@@ -23,4 +23,6 @@
         . S ZARY(BAT)=CNT_"^"_CNT ; FIRST AND LAST TESTS IN BATTERY
         . S ZARY("TESTS",BAT)="" ; PUT THE BATTERY IN THE TESTS INDEX
+        . ; S TN=$NA(ZARY("TESTS"))
+        . ; D PUSH^GPLXPATH(TN,BAT)
         S ZARY(0)=CNT ; update the array counter
         Q
@@ -50,32 +52,40 @@
        ;
 ZTEST(ZARY,WHICH)   ; try out the tests using a passed array ZTEST
-       N I,ZX,ZR,ZP
-       S DEBUG=0
-       I '$D(ZARY(WHICH))  D  ; TEST SECTION DOESN'T EXIST
-       . W "ERROR -- TEST SECTION DOESN'T EXIST -> ",WHICH,!
-       . Q ; EXIT
-       N FIRST,LAST
-       S FIRST=$P(ZARY(WHICH),"^",1)
-       S LAST=$P(ZARY(WHICH),"^",2)
-       F I=FIRST:1:LAST  D
-       . I ZARY(I)?1">"1.E  D  ; NOT A TEST, JUST RUN THE STATEMENT
-       . . S ZP=$E(ZARY(I),2,$L(ZARY(I)))
-       . . ;  W ZP,!
-       . . S ZX=ZP
-       . . W "RUNNING: "_ZP
-       . . X ZX
-       . . W "..SUCCESS: ",WHICH,!
-       . I ZARY(I)?1"?"1.E  D  ; THIS IS A TEST
-       . . S ZP=$E(ZARY(I),2,$L(ZARY(I)))
-       . . S ZX="S ZR="_ZP
-       . . W "TRYING: "_ZP
-       . . X ZX
-       . . W $S(ZR=1:"..PASSED ",1:"..FAILED "),!
-       . . I '$D(TPASSED) D  ; NOT INITIALIZED YET
-       . . . S TPASSED=0 S TFAILED=0
-       . . I ZR S TPASSED=TPASSED+1
-       . . I 'ZR S TFAILED=TFAILED+1
-       Q
-       ;
+        N I,ZX,ZR,ZP
+        S DEBUG=0
+        ; I WHICH="ALL" D  Q ; RUN ALL THE TESTS
+        ; . W "DOING ALL",!
+        ; . N J,NT
+        ; . S NT=$NA(ZARY("TESTS"))
+        ; . W NT,@NT@(0),!
+        ; . F J=1:1:@NT@(0) D  ;
+        ; . . W @NT@(J),!
+        ; . . D ZTEST^GPLUNIT(@ZARY,@NT@(J))
+        I '$D(ZARY(WHICH))  D  ; TEST SECTION DOESN'T EXIST
+        . W "ERROR -- TEST SECTION DOESN'T EXIST -> ",WHICH,!
+        . Q ; EXIT
+        N FIRST,LAST
+        S FIRST=$P(ZARY(WHICH),"^",1)
+        S LAST=$P(ZARY(WHICH),"^",2)
+        F I=FIRST:1:LAST  D
+        . I ZARY(I)?1">"1.E  D  ; NOT A TEST, JUST RUN THE STATEMENT
+        . . S ZP=$E(ZARY(I),2,$L(ZARY(I)))
+        . . ;  W ZP,!
+        . . S ZX=ZP
+        . . W "RUNNING: "_ZP
+        . . X ZX
+        . . W "..SUCCESS: ",WHICH,!
+        . I ZARY(I)?1"?"1.E  D  ; THIS IS A TEST
+        . . S ZP=$E(ZARY(I),2,$L(ZARY(I)))
+        . . S ZX="S ZR="_ZP
+        . . W "TRYING: "_ZP
+        . . X ZX
+        . . W $S(ZR=1:"..PASSED ",1:"..FAILED "),!
+        . . I '$D(TPASSED) D  ; NOT INITIALIZED YET
+        . . . S TPASSED=0 S TFAILED=0
+        . . I ZR S TPASSED=TPASSED+1
+        . . I 'ZR S TFAILED=TFAILED+1
+        Q
+        ;
 TEST   ; RUN ALL THE TEST CASES
       N ZTMP
@@ -89,4 +99,30 @@
       Q
       ;
+GTSTS(GTZARY,RTN) ; return an array of test names
+        N I,J S I="" S I=$O(GTZARY("TESTS",I))
+        F J=0:0  Q:I=""  D
+        . D PUSH^GPLXPATH(RTN,I)
+        . S I=$O(GTZARY("TESTS",I))
+        Q
+        ;
+TESTALL(RNM) ; RUN ALL THE TESTS
+        N I,J,TZTMP,TSTS,TOTP,TOTF
+        S TOTP=0 S TOTF=0
+        D ZLOAD^GPLUNIT("TZTMP",RNM)
+        D GTSTS(.TZTMP,"TSTS")
+        F I=1:1:TSTS(0) D  ;
+        . S TPASSED=0 S TFAILED=0
+        . D ZTEST^GPLUNIT(.TZTMP,TSTS(I))
+        . S TOTP=TOTP+TPASSED
+        . S TOTF=TOTF+TFAILED
+        . S $P(TSTS(I),"^",2)=TPASSED
+        . S $P(TSTS(I),"^",3)=TFAILED
+        F I=1:1:TSTS(0) D  ;
+        . W "TEST=> ",$P(TSTS(I),"^",1)
+        . W " PASSED=>",$P(TSTS(I),"^",2)
+        . W " FAILED=>",$P(TSTS(I),"^",3),!
+        W "TOTAL=> PASSED:",TOTP," FAILED:",TOTF,!
+        Q
+        ;
 TLIST(ZARY) ; LIST ALL THE TESTS
      ; THEY ARE MARKED AS ;;><TESTNAME> IN THE TEST CASES
Index: /ccr/trunk/p/GPLXPATH.m
===================================================================
--- /ccr/trunk/p/GPLXPATH.m	(revision 20)
+++ /ccr/trunk/p/GPLXPATH.m	(revision 30)
@@ -189,4 +189,5 @@
        . W "ERROR IN COPY BAD SOURCE LENGTH: ",CPSRC,!
        . Q
+       ; I '$D(@CPDEST@(0)) S @CPDEST@(0)=0 ; IF THE DEST IS EMPTY, INITIALIZE
        D QUEUE("CPINSTR",CPSRC,1,@CPSRC@(0)) ; BLIST FOR ENTIRE ARRAY
        D BUILD("CPINSTR",CPDEST)
@@ -238,12 +239,10 @@
        ; XML AT THE END OF THE XPATH POINT
        ; INSXML AND INSNEW ARE PASSED BY NAME INSXPATH IS A VALUE
-       ; N INSBLD,INSTMP
+       N INSBLD,INSTMP
        I DEBUG W "DOING INSERT ",INSXML,INSNEW,INSXPATH,!
        I DEBUG F G1=1:1:@INSXML@(0) W @INSXML@(G1),!
-       I '$D(@INSXML@(0)) D  ; INSERT INTO AN EMPTY ARRAY
-       . W "DOING A BAD COPY",!
-       . D CP^GPLXPATH(INSNEW,INXML) ; JUST COPY INTO THE OUTPUT
+       I '$D(@INSXML@(0)) D  Q ; INSERT INTO AN EMPTY ARRAY
+       . D CP^GPLXPATH(INSNEW,INSXML) ; JUST COPY INTO THE OUTPUT
        I $D(@INSXML@(0)) D  ; IF ORIGINAL ARRAY IS NOT EMPTY
-       . W "GOT HERE",!
        . I $D(INSXPATH) D  ; XPATH PROVIDED
        . . D QOPEN("INSBLD",INSXML,INSXPATH) ; COPY THE BEFORE
@@ -256,6 +255,6 @@
        . I '$D(INSXPATH) D  ; NO XPATH PROVIDED, CLOSE AT ROOT
        . . D QCLOSE("INSBLD",INSXML,"//") ; CLOSE WITH ROOT XPATH
-       . D BUILD("INSBLD",INSTMP) ; PUT RESULTS IN INDEST
-       . D CP^GPLXPATH(INSTMP,INSXML) ; COPY BUFFER TO SOURCE
+       . D BUILD("INSBLD","INSTMP") ; PUT RESULTS IN INDEST
+       . D CP^GPLXPATH("INSTMP",INSXML) ; COPY BUFFER TO SOURCE
        Q
        ;
@@ -334,21 +333,26 @@
       Q
       ;
-TEST   ; RUN ALL THE TEST CASES
-      N ZTMP
-      D ZLOAD^GPLUNIT("ZTMP","GPLXPATH")
-      D ZTEST^GPLUNIT(.ZTMP,"ALL")
-      W "PASSED: ",TPASSED,!
-      W "FAILED: ",TFAILED,!
-      W !
-      ; W "THE TESTS!",!
-      ; ZWR ZTMP
+TEST  ; Run all the test cases
+      D TESTALL^GPLUNIT("GPLXPATH")
       Q
       ;
+OLDTEST   ; RUN ALL THE TEST CASES
+        N ZTMP
+        D ZLOAD^GPLUNIT("ZTMP","GPLXPATH")
+        D ZTEST^GPLUNIT(.ZTMP,"ALL")
+        W "PASSED: ",TPASSED,!
+        W "FAILED: ",TFAILED,!
+        W !
+        ; W "THE TESTS!",!
+        ; ZWR ZTMP
+        Q
+        ;
 ZTEST(WHICH) ; RUN ONE SET OF TESTS
-      N ZTMP
-      D ZLOAD^GPLUNIT("ZTMP","GPLXPATH")
-      D ZTEST^GPLUNIT(.ZTMP,WHICH)
-      Q
-      ;
+        N ZTMP
+        S DEBUG=1
+        D ZLOAD^GPLUNIT("ZTMP","GPLXPATH")
+        D ZTEST^GPLUNIT(.ZTMP,WHICH)
+        Q
+        ;
 TLIST ; LIST THE TESTS
       N ZTMP
@@ -465,5 +469,5 @@
 ;;>>>D ZTEST^GPLXPATH("INITXML")
 ;;>>>D QOPEN^GPLXPATH("GBL","GXML")
-;;>>?$P(GBL(1),"^",3)=12
+;;>>?$P(GBL(1),";",3)=12
 ;;>>>D BUILD^GPLXPATH("GBL","G2")
 ;;>>?G2(G2(0))="</SECOND>"
@@ -472,5 +476,5 @@
 ;;>>>D ZTEST^GPLXPATH("INITXML")
 ;;>>>D QOPEN^GPLXPATH("GBL","GXML","//FIRST/SECOND")
-;;>>?$P(GBL(1),"^",3)=12
+;;>>?$P(GBL(1),";",3)=11
 ;;>>>D BUILD^GPLXPATH("GBL","G2")
 ;;>>?G2(G2(0))="</SECOND>"
@@ -479,5 +483,5 @@
 ;;>>>D ZTEST^GPLXPATH("INITXML")
 ;;>>>D QCLOSE^GPLXPATH("GBL","GXML")
-;;>>?$P(GBL(1),"^",3)=13
+;;>>?$P(GBL(1),";",3)=13
 ;;>>>D BUILD^GPLXPATH("GBL","G2")
 ;;>>?G2(G2(0))="</FIRST>"
@@ -486,5 +490,5 @@
 ;;>>>D ZTEST^GPLXPATH("INITXML")
 ;;>>>D QCLOSE^GPLXPATH("GBL","GXML","//FIRST/SECOND/THIRD")
-;;>>?$P(GBL(1),"^",3)=13
+;;>>?$P(GBL(1),";",3)=13
 ;;>>>D BUILD^GPLXPATH("GBL","G2")
 ;;>>?G2(G2(0))="</FIRST>"
@@ -494,7 +498,7 @@
 ;;>>>D ZTEST^GPLXPATH("INITXML")
 ;;>>>D QUERY^GPLXPATH("GXML","//FIRST/SECOND/THIRD/FIFTH","G2")
-;;>>>D INSERT^GPLXPATH("GXML","G2","G3","//FIRST/SECOND/THIRD")
-;;>>>D INSERT^GPLXPATH("G3","G2","G4","//FIRST/SECOND/THIRD")
-;;>>?G2(1)=G3(9)
+;;>>>D INSERT^GPLXPATH("GXML","G2","//FIRST/SECOND/THIRD")
+;;>>>D INSERT^GPLXPATH("G3","G2","//")
+;;>>?G2(1)=GXML(9)
 ;;><REPLACE>
 ;;>>>K G2,GBL,G3
