Index: /ccr/trunk/p/GPLACTOR.m
===================================================================
--- /ccr/trunk/p/GPLACTOR.m	(revision 111)
+++ /ccr/trunk/p/GPLACTOR.m	(revision 111)
@@ -0,0 +1,198 @@
+GPLACTORS  ; CCDCCR/GPL - CCR/CCD PROCESSING FOR ACTORS ; 7/3/08
+ ;;0.3;CCDCCR;nopatch;noreleasedate
+ ;Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
+ ;General Public License See attached copy of the License.
+ ;
+ ;This program is free software; you can redistribute it and/or modify
+ ;it under the terms of the GNU General Public License as published by
+ ;the Free Software Foundation; either version 2 of the License, or
+ ;(at your option) any later version.
+ ;
+ ;This program is distributed in the hope that it will be useful,
+ ;but WITHOUT ANY WARRANTY; without even the implied warranty of
+ ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ ;GNU General Public License for more details.
+ ;
+ ;You should have received a copy of the GNU General Public License along
+ ;with this program; if not, write to the Free Software Foundation, Inc.,
+ ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+    ;
+    ;  PROCESS THE ACTORS SECTION OF THE CCR
+    ;
+    ; ===Revision History===
+    ; 0.1 Initial Writing of Skeleton--GPL
+    ; 0.2 Patient Data Extraction--SMH
+    ; 0.3 Information System Info Extraction--SMH
+    ;
+EXTRACT(IPXML,ALST,AXML) ; EXTRACT ACTOR FROM ALST INTO PROVIDED XML TEMPLATE
+  ; IPXML is the Input Actor Template into which we  substitute values
+  ; This is straight XML. Values to be substituted are in @@VAL@@ format.
+  ; ALST is the actor list global generated by ACTLST^GPLCCR and has format:
+  ; ^TMP(7542,1,"ACTORS",0)=Count
+  ; ^TMP(7542,1,"ACTORS",n)="ActorID^ActorType^ActorIEN"
+  ; ActorType is an enum containing either "PROVIDER" "PATIENT" "SYSTEM"
+  ; AXML is the output arrary, to contain XML.
+  ;
+           N I,J,AMAP,AOID,ATYP,AIEN
+           D CP^GPLXPATH(IPXML,AXML) ; MAKE A COPY OF ACTORS XML
+           D REPLACE^GPLXPATH(AXML,"","//Actors") ; DELETE THE INSIDES
+           W "PROCESSING ACTORS ",!
+           F I=1:1:@ALST@(0) D  ; PROCESS ALL ACTORS IN THE LIST
+           . I @ALST@(I)["@@" Q  ; NOT A VALID ACTOR
+           . S AOID=$P(@ALST@(I),"^",1) ; ACTOR OBJECT ID
+           . S ATYP=$P(@ALST@(I),"^",2) ; ACTOR TYPE
+           . S AIEN=$P(@ALST@(I),"^",3) ; ACTOR RECORD NUMBER
+           . I ATYP="" Q  ; NOT A VALID ACTOR
+           . ;
+           . W AOID_" "_ATYP_" "_AIEN,!
+           . I ATYP="PATIENT" D  ; PATIENT ACTOR TYPE
+           . . D QUERY^GPLXPATH(IPXML,"//Actors/ACTOR-PATIENT","ATMP")
+           . . D PATIENT("ATMP",AIEN,AOID,"ATMP2")
+           . ;
+           . I ATYP="SYSTEM" D  ; SYSTEM ACTOR TYPE
+           . . D QUERY^GPLXPATH(IPXML,"//Actors/ACTOR-SYSTEM","ATMP")
+           . . D SYSTEM("ATMP",AIEN,AOID,"ATMP2")
+           . ;
+           . I ATYP="NOK" D  ; NOK ACTOR TYPE
+           . . D QUERY^GPLXPATH(IPXML,"//Actors/ACTOR-NOK","ATMP")
+           . . D NOK("ATMP",AIEN,AOID,"ATMP2")
+           . ;
+           . I ATYP="PROVIDER" D  ; PROVIDER ACTOR TYPE
+           . . D QUERY^GPLXPATH(IPXML,"//Actors/ACTOR-PROVIDER","ATMP")
+           . . D PROVIDER("ATMP",AIEN,AOID,"ATMP2")
+           . ;
+           . I ATYP="ORGANIZATION" D  ; PROVIDER ACTOR TYPE
+           . . D QUERY^GPLXPATH(IPXML,"//Actors/ACTOR-ORG","ATMP")
+           . . D ORG("ATMP",AIEN,AOID,"ATMP2")
+           . ;
+           . D INSINNER^GPLXPATH(AXML,"ATMP2") ; INSERT INTO ROOT
+           ;
+           N ACTTMP
+           D MISSING^GPLXPATH(AXML,"ACTTMP") ; SEARCH XML FOR MISSING VARS
+           I ACTTMP(0)>0  D  ; IF THERE ARE MISSING VARS -
+           . ; STRINGS MARKED AS @@X@@
+           . W "ACTORS Missing list: ",!
+           . F I=1:1:ACTTMP(0) W ACTTMP(I),!
+           Q
+           ;
+PATIENT(INXML,AIEN,AOID,OUTXML) ; PROCESS A PATIENT ACTOR
+     ;
+     W "PROCESSING ACTOR PATIENT ",AIEN,!
+     N AMAP,ZX
+     S AMAP=$NA(^TMP($J,"AMAP"))
+     K @AMAP
+         D INIT^CCRDPT(AIEN)
+     S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
+     S @AMAP@("ACTORGIVENNAME")=$$GIVEN^CCRDPT
+     S @AMAP@("ACTORMIDDLENAME")=$$MIDDLE^CCRDPT
+     S @AMAP@("ACTORFAMILYNAME")=$$FAMILY^CCRDPT
+     S @AMAP@("ACTORDATEOFBIRTH")=$$DOB^CCRDPT
+     S @AMAP@("ACTORGENDER")=$$GENDER^CCRDPT
+     S @AMAP@("ACTORSSN")=""
+     S @AMAP@("ACTORSSNTEXT")=""
+     S @AMAP@("ACTORSSNSOURCEID")=""
+     S ZX=$$SSN^CCRDPT
+     I ZX'="" D  ; IF THERE IS A SSN IN THE RECORD
+     . S @AMAP@("ACTORSSN")=ZX
+     . S @AMAP@("ACTORSSNTEXT")="SSN"
+     . S @AMAP@("ACTORSSNSOURCEID")=AOID
+     S @AMAP@("ACTORADDRESSTYPE")=$$ADDRTYPE^CCRDPT
+     S @AMAP@("ACTORADDRESSLINE1")=$$ADDR1^CCRDPT
+     S @AMAP@("ACTORADDRESSLINE2")=$$ADDR2^CCRDPT
+     S @AMAP@("ACTORADDRESSCITY")=$$CITY^CCRDPT
+     S @AMAP@("ACTORADDRESSSTATE")=$$STATE^CCRDPT
+     S @AMAP@("ACTORADDRESSZIPCODE")=$$ZIP^CCRDPT
+     S @AMAP@("ACTORRESTEL")=""
+     S @AMAP@("ACTORRESTELTEXT")=""
+     S ZX=$$RESTEL^CCRDPT
+     I ZX'="" D  ; IF THERE IS A RESIDENT PHONE IN THE RECORD
+     . S @AMAP@("ACTORRESTEL")=ZX
+     . S @AMAP@("ACTORRESTELTEXT")="Residential Telephone"
+     S @AMAP@("ACTORWORKTEL")=""
+     S @AMAP@("ACTORWORKTELTEXT")=""
+     S ZX=$$WORKTEL^CCRDPT
+     I ZX'="" D  ; IF THERE IS A RESIDENT PHONE IN THE RECORD
+     . S @AMAP@("ACTORWORKTEL")=ZX
+     . S @AMAP@("ACTORWORKTELTEXT")="Work Telephone"
+     S @AMAP@("ACTORCELLTEL")=""
+     S @AMAP@("ACTORCELLTELTEXT")=""
+     S ZX=$$CELLTEL^CCRDPT
+     I ZX'="" D  ; IF THERE IS A CELL PHONE IN THE RECORD
+     . S @AMAP@("ACTORCELLTEL")=ZX
+     . S @AMAP@("ACTORCELLTELTEXT")="Cell Phone"
+     S @AMAP@("ACTOREMAIL")=$$EMAIL^CCRDPT
+     S @AMAP@("ACTORADDRESSSOURCEID")=AOID
+     S @AMAP@("ACTORIEN")=AIEN
+     S @AMAP@("ACTORSUFFIXNAME")="" ; DOES VISTA STORE THE SUFFIX
+     S @AMAP@("ACTORSOURCEID")="ACTORSYSTEM_1" ; THE SYSTEM IS THE SOURCE
+         D DESTROY^CCRDPT
+     D MAP^GPLXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
+     Q
+     ;
+SYSTEM(INXML,AIEN,AOID,OUTXML) ; PROCESS A SYSTEM ACTOR
+     ;
+     ; N AMAP
+     S AMAP=$NA(^TMP($J,"AMAP"))
+     K @AMAP
+     S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
+     S @AMAP@("ACTORINFOSYSNAME")=$$SYSNAME^CCRSYS
+         S @AMAP@("ACTORINFOSYSVER")=$$SYSVER^CCRSYS
+     S @AMAP@("ACTORINFOSYSSOURCEID")=AOID
+     D MAP^GPLXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
+     Q
+     ;
+NOK(INXML,AIEN,AOID,OUTXML) ; PROCESS A NEXT OF KIN TYPE ACTOR
+     ;
+     ; N AMAP
+     S AMAP=$NA(^TMP($J,"AMAP"))
+     K @AMAP
+     S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
+     S @AMAP@("ACTORDISPLAYNAME")=""
+     S @AMAP@("ACTORRELATION")=""
+     S @AMAP@("ACTORRELATIONSOURCEID")=""
+     S @AMAP@("ACTORSOURCEID")="ACTORSYSTEM_1" ; THE SYSTEM IS THE SOURCE
+     D MAP^GPLXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
+     Q
+     ;
+ORG(INXML,AIEN,AOID,OUTXML) ; PROCESS AN ORGANIZATION TYPE ACTOR
+     ;
+     ; N AMAP
+     S AMAP=$NA(^TMP($J,"AMAP"))
+     K @AMAP
+     S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
+     S @AMAP@("ORGANIZATIONNAME")=$P($$SITE^VASITE,U,2)
+     S @AMAP@("ACTORSOURCEID")="ACTORSYSTEM_1"
+     D MAP^GPLXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
+     Q
+     ;
+PROVIDER(INXML,AIEN,AOID,OUTXML) ; PROCESS A PROVIDER TYPE ACTOR
+     ;
+     ; N AMAP
+     S AMAP=$NA(^TMP($J,"AMAP"))
+     K @AMAP
+     S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
+     S @AMAP@("ACTORGIVENNAME")=$$GIVEN^CCRVA200(AIEN)
+     S @AMAP@("ACTORMIDDLENAME")=$$MIDDLE^CCRVA200(AIEN)
+     S @AMAP@("ACTORFAMILYNAME")=$$FAMILY^CCRVA200(AIEN)
+         S @AMAP@("ACTORTITLE")=$$TITLE^CCRVA200(AIEN)
+         S @AMAP@("IDTYPE")=$P($$NPI^CCRVA200(AIEN),U,1)
+         S @AMAP@("ID")=$P($$NPI^CCRVA200(AIEN),U,2)
+         S @AMAP@("IDDESC")=$P($$NPI^CCRVA200(AIEN),U,3)
+     S @AMAP@("ACTORSPECIALITY")=$$SPEC^CCRVA200(AIEN)
+     S @AMAP@("ACTORADDRESSTYPE")=$$ADDTYPE^CCRVA200(AIEN)
+     S @AMAP@("ACTORADDRESSLINE1")=$$ADDLINE1^CCRVA200(AIEN)
+     S @AMAP@("ACTORADDRESSCITY")=$$CITY^CCRVA200(AIEN)
+     S @AMAP@("ACTORADDRESSSTATE")=$$STATE^CCRVA200(AIEN)
+     S @AMAP@("ACTORPOSTALCODE")=$$POSTCODE^CCRVA200(AIEN)
+     S @AMAP@("ACTORTELEPHONE")=""
+     S @AMAP@("ACTORTELEPHONETYPE")=""
+     S ZX=$$TEL^CCRVA200(AIEN)
+     I ZX'="" D  ; THERE IS A PHONE NUMBER AVAILABLE
+     . S @AMAP@("ACTORTELEPHONE")=ZX
+     . S @AMAP@("ACTORTELEPHONETYPE")=$$TELTYPE^CCRVA200(AIEN)
+     S @AMAP@("ACTOREMAIL")=$$EMAIL^CCRVA200(AIEN)
+     S @AMAP@("ACTORADDRESSSOURCEID")="ACTORSYSTEM_1"
+     S @AMAP@("ACTORSOURCEID")="ACTORSYSTEM_1" ; THE SYSTEM IS THE SOURCE
+     D MAP^GPLXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
+     Q
+     ;
Index: r/trunk/p/GPLACTORS.m
===================================================================
--- /ccr/trunk/p/GPLACTORS.m	(revision 110)
+++ 	(revision )
@@ -1,198 +1,0 @@
-GPLACTORS  ; CCDCCR/GPL - CCR/CCD PROCESSING FOR ACTORS ; 7/3/08
- ;;0.3;CCDCCR;nopatch;noreleasedate
- ;Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
- ;General Public License See attached copy of the License.
- ;
- ;This program is free software; you can redistribute it and/or modify
- ;it under the terms of the GNU General Public License as published by
- ;the Free Software Foundation; either version 2 of the License, or
- ;(at your option) any later version.
- ;
- ;This program is distributed in the hope that it will be useful,
- ;but WITHOUT ANY WARRANTY; without even the implied warranty of
- ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
- ;GNU General Public License for more details.
- ;
- ;You should have received a copy of the GNU General Public License along
- ;with this program; if not, write to the Free Software Foundation, Inc.,
- ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
-    ;
-    ;  PROCESS THE ACTORS SECTION OF THE CCR
-    ;
-    ; ===Revision History===
-    ; 0.1 Initial Writing of Skeleton--GPL
-    ; 0.2 Patient Data Extraction--SMH
-    ; 0.3 Information System Info Extraction--SMH
-    ;
-EXTRACT(IPXML,ALST,AXML) ; EXTRACT ACTOR FROM ALST INTO PROVIDED XML TEMPLATE
-  ; IPXML is the Input Actor Template into which we  substitute values
-  ; This is straight XML. Values to be substituted are in @@VAL@@ format.
-  ; ALST is the actor list global generated by ACTLST^GPLCCR and has format:
-  ; ^TMP(7542,1,"ACTORS",0)=Count
-  ; ^TMP(7542,1,"ACTORS",n)="ActorID^ActorType^ActorIEN"
-  ; ActorType is an enum containing either "PROVIDER" "PATIENT" "SYSTEM"
-  ; AXML is the output arrary, to contain XML.
-  ;
-           N I,J,AMAP,AOID,ATYP,AIEN
-           D CP^GPLXPATH(IPXML,AXML) ; MAKE A COPY OF ACTORS XML
-           D REPLACE^GPLXPATH(AXML,"","//Actors") ; DELETE THE INSIDES
-           W "PROCESSING ACTORS ",!
-           F I=1:1:@ALST@(0) D  ; PROCESS ALL ACTORS IN THE LIST
-           . I @ALST@(I)["@@" Q  ; NOT A VALID ACTOR
-           . S AOID=$P(@ALST@(I),"^",1) ; ACTOR OBJECT ID
-           . S ATYP=$P(@ALST@(I),"^",2) ; ACTOR TYPE
-           . S AIEN=$P(@ALST@(I),"^",3) ; ACTOR RECORD NUMBER
-           . I ATYP="" Q  ; NOT A VALID ACTOR
-           . ;
-           . W AOID_" "_ATYP_" "_AIEN,!
-           . I ATYP="PATIENT" D  ; PATIENT ACTOR TYPE
-           . . D QUERY^GPLXPATH(IPXML,"//Actors/ACTOR-PATIENT","ATMP")
-           . . D PATIENT("ATMP",AIEN,AOID,"ATMP2")
-           . ;
-           . I ATYP="SYSTEM" D  ; SYSTEM ACTOR TYPE
-           . . D QUERY^GPLXPATH(IPXML,"//Actors/ACTOR-SYSTEM","ATMP")
-           . . D SYSTEM("ATMP",AIEN,AOID,"ATMP2")
-           . ;
-           . I ATYP="NOK" D  ; NOK ACTOR TYPE
-           . . D QUERY^GPLXPATH(IPXML,"//Actors/ACTOR-NOK","ATMP")
-           . . D NOK("ATMP",AIEN,AOID,"ATMP2")
-           . ;
-           . I ATYP="PROVIDER" D  ; PROVIDER ACTOR TYPE
-           . . D QUERY^GPLXPATH(IPXML,"//Actors/ACTOR-PROVIDER","ATMP")
-           . . D PROVIDER("ATMP",AIEN,AOID,"ATMP2")
-           . ;
-           . I ATYP="ORGANIZATION" D  ; PROVIDER ACTOR TYPE
-           . . D QUERY^GPLXPATH(IPXML,"//Actors/ACTOR-ORG","ATMP")
-           . . D ORG("ATMP",AIEN,AOID,"ATMP2")
-           . ;
-           . D INSINNER^GPLXPATH(AXML,"ATMP2") ; INSERT INTO ROOT
-           ;
-           N ACTTMP
-           D MISSING^GPLXPATH(AXML,"ACTTMP") ; SEARCH XML FOR MISSING VARS
-           I ACTTMP(0)>0  D  ; IF THERE ARE MISSING VARS -
-           . ; STRINGS MARKED AS @@X@@
-           . W "ACTORS Missing list: ",!
-           . F I=1:1:ACTTMP(0) W ACTTMP(I),!
-           Q
-           ;
-PATIENT(INXML,AIEN,AOID,OUTXML) ; PROCESS A PATIENT ACTOR
-     ;
-     W "PROCESSING ACTOR PATIENT ",AIEN,!
-     N AMAP,ZX
-     S AMAP=$NA(^TMP($J,"AMAP"))
-     K @AMAP
-         D INIT^CCRDPT(AIEN)
-     S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
-     S @AMAP@("ACTORGIVENNAME")=$$GIVEN^CCRDPT
-     S @AMAP@("ACTORMIDDLENAME")=$$MIDDLE^CCRDPT
-     S @AMAP@("ACTORFAMILYNAME")=$$FAMILY^CCRDPT
-     S @AMAP@("ACTORDATEOFBIRTH")=$$DOB^CCRDPT
-     S @AMAP@("ACTORGENDER")=$$GENDER^CCRDPT
-     S @AMAP@("ACTORSSN")=""
-     S @AMAP@("ACTORSSNTEXT")=""
-     S @AMAP@("ACTORSSNSOURCEID")=""
-     S ZX=$$SSN^CCRDPT
-     I ZX'="" D  ; IF THERE IS A SSN IN THE RECORD
-     . S @AMAP@("ACTORSSN")=ZX
-     . S @AMAP@("ACTORSSNTEXT")="SSN"
-     . S @AMAP@("ACTORSSNSOURCEID")=AOID
-     S @AMAP@("ACTORADDRESSTYPE")=$$ADDRTYPE^CCRDPT
-     S @AMAP@("ACTORADDRESSLINE1")=$$ADDR1^CCRDPT
-     S @AMAP@("ACTORADDRESSLINE2")=$$ADDR2^CCRDPT
-     S @AMAP@("ACTORADDRESSCITY")=$$CITY^CCRDPT
-     S @AMAP@("ACTORADDRESSSTATE")=$$STATE^CCRDPT
-     S @AMAP@("ACTORADDRESSZIPCODE")=$$ZIP^CCRDPT
-     S @AMAP@("ACTORRESTEL")=""
-     S @AMAP@("ACTORRESTELTEXT")=""
-     S ZX=$$RESTEL^CCRDPT
-     I ZX'="" D  ; IF THERE IS A RESIDENT PHONE IN THE RECORD
-     . S @AMAP@("ACTORRESTEL")=ZX
-     . S @AMAP@("ACTORRESTELTEXT")="Residential Telephone"
-     S @AMAP@("ACTORWORKTEL")=""
-     S @AMAP@("ACTORWORKTELTEXT")=""
-     S ZX=$$WORKTEL^CCRDPT
-     I ZX'="" D  ; IF THERE IS A RESIDENT PHONE IN THE RECORD
-     . S @AMAP@("ACTORWORKTEL")=ZX
-     . S @AMAP@("ACTORWORKTELTEXT")="Work Telephone"
-     S @AMAP@("ACTORCELLTEL")=""
-     S @AMAP@("ACTORCELLTELTEXT")=""
-     S ZX=$$CELLTEL^CCRDPT
-     I ZX'="" D  ; IF THERE IS A CELL PHONE IN THE RECORD
-     . S @AMAP@("ACTORCELLTEL")=ZX
-     . S @AMAP@("ACTORCELLTELTEXT")="Cell Phone"
-     S @AMAP@("ACTOREMAIL")=$$EMAIL^CCRDPT
-     S @AMAP@("ACTORADDRESSSOURCEID")=AOID
-     S @AMAP@("ACTORIEN")=AIEN
-     S @AMAP@("ACTORSUFFIXNAME")="" ; DOES VISTA STORE THE SUFFIX
-     S @AMAP@("ACTORSOURCEID")="ACTORSYSTEM_1" ; THE SYSTEM IS THE SOURCE
-         D DESTROY^CCRDPT
-     D MAP^GPLXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
-     Q
-     ;
-SYSTEM(INXML,AIEN,AOID,OUTXML) ; PROCESS A SYSTEM ACTOR
-     ;
-     ; N AMAP
-     S AMAP=$NA(^TMP($J,"AMAP"))
-     K @AMAP
-     S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
-     S @AMAP@("ACTORINFOSYSNAME")=$$SYSNAME^CCRSYS
-         S @AMAP@("ACTORINFOSYSVER")=$$SYSVER^CCRSYS
-     S @AMAP@("ACTORINFOSYSSOURCEID")=AOID
-     D MAP^GPLXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
-     Q
-     ;
-NOK(INXML,AIEN,AOID,OUTXML) ; PROCESS A NEXT OF KIN TYPE ACTOR
-     ;
-     ; N AMAP
-     S AMAP=$NA(^TMP($J,"AMAP"))
-     K @AMAP
-     S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
-     S @AMAP@("ACTORDISPLAYNAME")=""
-     S @AMAP@("ACTORRELATION")=""
-     S @AMAP@("ACTORRELATIONSOURCEID")=""
-     S @AMAP@("ACTORSOURCEID")="ACTORSYSTEM_1" ; THE SYSTEM IS THE SOURCE
-     D MAP^GPLXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
-     Q
-     ;
-ORG(INXML,AIEN,AOID,OUTXML) ; PROCESS AN ORGANIZATION TYPE ACTOR
-     ;
-     ; N AMAP
-     S AMAP=$NA(^TMP($J,"AMAP"))
-     K @AMAP
-     S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
-     S @AMAP@("ORGANIZATIONNAME")=$P($$SITE^VASITE,U,2)
-     S @AMAP@("ACTORSOURCEID")="ACTORSYSTEM_1"
-     D MAP^GPLXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
-     Q
-     ;
-PROVIDER(INXML,AIEN,AOID,OUTXML) ; PROCESS A PROVIDER TYPE ACTOR
-     ;
-     ; N AMAP
-     S AMAP=$NA(^TMP($J,"AMAP"))
-     K @AMAP
-     S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
-     S @AMAP@("ACTORGIVENNAME")=$$GIVEN^CCRVA200(AIEN)
-     S @AMAP@("ACTORMIDDLENAME")=$$MIDDLE^CCRVA200(AIEN)
-     S @AMAP@("ACTORFAMILYNAME")=$$FAMILY^CCRVA200(AIEN)
-         S @AMAP@("ACTORTITLE")=$$TITLE^CCRVA200(AIEN)
-         S @AMAP@("IDTYPE")=$P($$NPI^CCRVA200(AIEN),U,1)
-         S @AMAP@("ID")=$P($$NPI^CCRVA200(AIEN),U,2)
-         S @AMAP@("IDDESC")=$P($$NPI^CCRVA200(AIEN),U,3)
-     S @AMAP@("ACTORSPECIALITY")=$$SPEC^CCRVA200(AIEN)
-     S @AMAP@("ACTORADDRESSTYPE")=$$ADDTYPE^CCRVA200(AIEN)
-     S @AMAP@("ACTORADDRESSLINE1")=$$ADDLINE1^CCRVA200(AIEN)
-     S @AMAP@("ACTORADDRESSCITY")=$$CITY^CCRVA200(AIEN)
-     S @AMAP@("ACTORADDRESSSTATE")=$$STATE^CCRVA200(AIEN)
-     S @AMAP@("ACTORPOSTALCODE")=$$POSTCODE^CCRVA200(AIEN)
-     S @AMAP@("ACTORTELEPHONE")=""
-     S @AMAP@("ACTORTELEPHONETYPE")=""
-     S ZX=$$TEL^CCRVA200(AIEN)
-     I ZX'="" D  ; THERE IS A PHONE NUMBER AVAILABLE
-     . S @AMAP@("ACTORTELEPHONE")=ZX
-     . S @AMAP@("ACTORTELEPHONETYPE")=$$TELTYPE^CCRVA200(AIEN)
-     S @AMAP@("ACTOREMAIL")=$$EMAIL^CCRVA200(AIEN)
-     S @AMAP@("ACTORADDRESSSOURCEID")="ACTORSYSTEM_1"
-     S @AMAP@("ACTORSOURCEID")="ACTORSYSTEM_1" ; THE SYSTEM IS THE SOURCE
-     D MAP^GPLXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
-     Q
-     ;
Index: /ccr/trunk/p/GPLCCD.m
===================================================================
--- /ccr/trunk/p/GPLCCD.m	(revision 110)
+++ /ccr/trunk/p/GPLCCD.m	(revision 111)
@@ -80,5 +80,5 @@
     S ZZX="//ContinuityOfCareRecord/recordTarget/patientRole/patient"
     D QUERY^GPLXPATH(CCDGLO,ZZX,"ACTT1")
-    D PATIENT^GPLACTORS("ACTT1",DFN,"ACTORPATIENT_"_DFN,"ACTT2") ; MAP PATIENT
+    D PATIENT^GPLACTOR("ACTT1",DFN,"ACTORPATIENT_"_DFN,"ACTT2") ; MAP PATIENT
     I DEBUG D PARY^GPLXPATH("ACTT2")
     D REPLACE^GPLXPATH(CCDGLO,"ACTT2",ZZX)
@@ -140,5 +140,5 @@
     D PUSH^GPLXPATH(TAB,"EXTRACT;GPLPROBS;//ContinuityOfCareRecord/Body/Problems;^TMP(""GPLCCR"",$J,DFN,""PROBLEMS"")")
     ;D PUSH^GPLXPATH(TAB,"EXTRACT;GPLMEDS;//ContinuityOfCareRecord/Body/Medications;^TMP(""GPLCCR"",$J,DFN,""MEDICATIONS"")")
-    I 'CCD D PUSH^GPLXPATH(TAB,"EXTRACT;GPLVITALS;//ContinuityOfCareRecord/Body/VitalSigns;^TMP(""GPLCCR"",$J,DFN,""VITALS"")")
+    I 'CCD D PUSH^GPLXPATH(TAB,"EXTRACT;GPLVITAL;//ContinuityOfCareRecord/Body/VitalSigns;^TMP(""GPLCCR"",$J,DFN,""VITALS"")")
     Q
     ;
@@ -249,5 +249,5 @@
  ;;>>>D ZTEST^GPLCCR("ACTLST")
  ;;>>>D QUERY^GPLXPATH(TGLOBAL,"//ContinuityOfCareRecord/Actors","G2")
- ;;>>>D EXTRACT^GPLACTORS("G2","ACTTEST","G3")
+ ;;>>>D EXTRACT^GPLACTOR("G2","ACTTEST","G3")
  ;;>>?G3(G3(0))["</Actors>"
  ;;><TRIM>
Index: /ccr/trunk/p/GPLCCR.m
===================================================================
--- /ccr/trunk/p/GPLCCR.m	(revision 110)
+++ /ccr/trunk/p/GPLCCR.m	(revision 111)
@@ -100,5 +100,5 @@
     D ACTLST^GPLCCR(CCRGLO,ACTGLO) ; GEN THE ACTOR LIST
     D QUERY^GPLXPATH(TGLOBAL,"//ContinuityOfCareRecord/Actors","ACTT")
-    D EXTRACT^GPLACTORS("ACTT",ACTGLO,"ACTT2")
+    D EXTRACT^GPLACTOR("ACTT",ACTGLO,"ACTT2")
     D INSINNER^GPLXPATH(CCRGLO,"ACTT2","//ContinuityOfCareRecord/Actors")
     N TRIMI,J,DONE S DONE=0
@@ -115,5 +115,5 @@
     D PUSH^GPLXPATH(TAB,"EXTRACT;GPLPROBS;//ContinuityOfCareRecord/Body/Problems;^TMP(""GPLCCR"",$J,DFN,""PROBLEMS"")")
     D PUSH^GPLXPATH(TAB,"EXTRACT;GPLMEDS;//ContinuityOfCareRecord/Body/Medications;^TMP(""GPLCCR"",$J,DFN,""MEDICATIONS"")")
-    D PUSH^GPLXPATH(TAB,"EXTRACT;GPLVITALS;//ContinuityOfCareRecord/Body/VitalSigns;^TMP(""GPLCCR"",$J,DFN,""VITALS"")")
+    D PUSH^GPLXPATH(TAB,"EXTRACT;GPLVITAL;//ContinuityOfCareRecord/Body/VitalSigns;^TMP(""GPLCCR"",$J,DFN,""VITALS"")")
     I TESTLAB D PUSH^GPLXPATH(TAB,"EXTRACT;GPLLABS;//ContinuityOfCareRecord/Body/Results;^TMP(""GPLCCR"",$J,DFN,""RESULTS"")")
     Q
@@ -199,5 +199,5 @@
  ;;>>>D ZTEST^GPLCCR("ACTLST")
  ;;>>>D QUERY^GPLXPATH(TGLOBAL,"//ContinuityOfCareRecord/Actors","G2")
- ;;>>>D EXTRACT^GPLACTORS("G2","ACTTEST","G3")
+ ;;>>>D EXTRACT^GPLACTOR("G2","ACTTEST","G3")
  ;;>>?G3(G3(0))["</Actors>"
  ;;><TRIM>
Index: /ccr/trunk/p/GPLVITAL.m
===================================================================
--- /ccr/trunk/p/GPLVITAL.m	(revision 111)
+++ /ccr/trunk/p/GPLVITAL.m	(revision 111)
@@ -0,0 +1,176 @@
+GPLVITALS ; CCDCCR/CJE - CCR/CCD PROCESSING FOR VITALS ; 07/16/08
+          ;;0.1;CCDCCR;;JUL 16,2008;
+          ;Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
+          ;General Public License See attached copy of the License.
+          ;
+          ;This program is free software; you can redistribute it and/or modify
+          ;it under the terms of the GNU General Public License as published by
+          ;the Free Software Foundation; either version 2 of the License, or
+          ;(at your option) any later version.
+          ;
+          ;This program is distributed in the hope that it will be useful,
+          ;but WITHOUT ANY WARRANTY; without even the implied warranty of
+          ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+          ;GNU General Public License for more details.
+          ;
+          ;You should have received a copy of the GNU General Public License along
+          ;with this program; if not, write to the Free Software Foundation, Inc.,
+          ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+          ;
+          W "NO ENTRY FROM TOP",!
+          Q
+          ;
+EXTRACT(VITXML,DFN,VITOUTXML) ; EXTRACT VITALS INTO PROVIDED XML TEMPLATE
+          ;
+          ; VITXML AND OUTXML ARE PASSED BY NAME SO GLOBALS CAN BE USED
+          ; IVITXML WILL CONTAIN ONLY THE VITALS SECTION OF THE OVERALL TEMPLATE
+          ;
+          N VITRSLT,J,K,VITPTMP,X,VITVMAP,TBUF
+          D VITALS^ORQQVI(.VITRSLT,DFN,"","")
+          I $P(VITRSLT(1),U,2)="No vitals found." D  ; NULL RESULT FROM RPC
+          . W "NO VITALS FOUND FROM VITALS RPC",!
+          . S @VITOUTXML@(0)=0
+          . Q
+          ; ZWR RPCRSLT
+          S VITTVMAP=$NA(^TMP("GPLCCR",$J,"VITALS"))
+          S VITTARYTMP=$NA(^TMP("GPLCCR",$J,"VITALARYTMP"))
+          K @VITTVMAP,@VITTARYTMP ; KILL OLD ARRAY VALUES
+          F J=1:1:VITRSLT(1)  D  ; FOR EACH VITAL IN THE LIST
+          . I $D(VITRSLT(J)) D
+          . . S VITVMAP=$NA(@VITTVMAP@(J))
+          . . K @VITVMAP
+          . . I DEBUG W "VMAP= ",VITVMAP,!
+          . . S VITPTMP=VITRSLT(J) ; PULL OUT VITAL FROM RPC RETURN ARRAY
+          . . S @VITVMAP@("VITALSIGNSDATAOBJECTID")="VITAL"_J ; UNIQUE OBJID FOR VITAL
+          . . I $P(VITPTMP,U,2)="HT" D
+          . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
+          . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^CCRUTIL($P(VITPTMP,U,4),"DT")
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="HEIGHT"
+          . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
+          . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
+          . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="OBSERVED"
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="HEIGHT"
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODEVALUE")="248327008"
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODINGSYSTEM")="SNOMED"
+          . . . S @VITVMAP@("VITALSIGNSCODEVERSION")=""
+          . . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P(^GMR(120.5,$P(VITPTMP,U,1),0),U,6)
+          . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3)
+          . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")="in"
+          . . E  I $P(VITPTMP,U,2)="WT" D
+          . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
+          . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^CCRUTIL($P(VITPTMP,U,4),"DT")
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="WEIGHT"
+          . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
+          . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
+          . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="OBSERVED"
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="WEIGHT"
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODEVALUE")="107647005"
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODINGSYSTEM")="SNOMED"
+          . . . S @VITVMAP@("VITALSIGNSCODEVERSION")=""
+          . . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P(^GMR(120.5,$P(VITPTMP,U,1),0),U,6)
+          . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3)
+          . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")="lbs"
+          . . E  I $P(VITPTMP,U,2)="BP" D
+          . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
+          . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^CCRUTIL($P(VITPTMP,U,4),"DT")
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="BLOOD PRESSURE"
+          . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
+          . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
+          . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="OBSERVED"
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="BLOOD PRESSURE"
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODEVALUE")="392570002"
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODINGSYSTEM")="SNOMED"
+          . . . S @VITVMAP@("VITALSIGNSCODEVERSION")=""
+          . . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P(^GMR(120.5,$P(VITPTMP,U,1),0),U,6)
+          . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3)
+          . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")=""
+          . . E  I $P(VITPTMP,U,2)="T" D
+          . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
+          . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^CCRUTIL($P(VITPTMP,U,4),"DT")
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="TEMPERATURE"
+          . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
+          . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
+          . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="OBSERVED"
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="TEMPERATURE"
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODEVALUE")="309646008"
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODINGSYSTEM")="SNOMED"
+          . . . S @VITVMAP@("VITALSIGNSCODEVERSION")=""
+          . . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P(^GMR(120.5,$P(VITPTMP,U,1),0),U,6)
+          . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3)
+          . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")="F"
+          . . E  I $P(VITPTMP,U,2)="R" D
+          . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
+          . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^CCRUTIL($P(VITPTMP,U,4),"DT")
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="RESPIRATION"
+          . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
+          . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
+          . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="OBSERVED"
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="RESPIRATION"
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODEVALUE")="366147009"
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODINGSYSTEM")="SNOMED"
+          . . . S @VITVMAP@("VITALSIGNSCODEVERSION")=""
+          . . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P(^GMR(120.5,$P(VITPTMP,U,1),0),U,6)
+          . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3)
+          . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")=""
+          . . E  I $P(VITPTMP,U,2)="P" D
+          . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
+          . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^CCRUTIL($P(VITPTMP,U,4),"DT")
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="PULSE"
+          . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
+          . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
+          . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="OBSERVED"
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="PULSE"
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODEVALUE")="366199006"
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODINGSYSTEM")="SNOMED"
+          . . . S @VITVMAP@("VITALSIGNSCODEVERSION")=""
+          . . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P(^GMR(120.5,$P(VITPTMP,U,1),0),U,6)
+          . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3)
+          . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")=""
+          . . E  I $P(VITPTMP,U,2)="PN" D
+          . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
+          . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^CCRUTIL($P(VITPTMP,U,4),"DT")
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="PAIN"
+          . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
+          . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
+          . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="OBSERVED"
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="PAIN"
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODEVALUE")="22253000"
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODINGSYSTEM")="SNOMED"
+          . . . S @VITVMAP@("VITALSIGNSCODEVERSION")=""
+          . . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P(^GMR(120.5,$P(VITPTMP,U,1),0),U,6)
+          . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3)
+          . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")=""
+          . . E  D
+          . . . ;W "IN VITAL:  OTHER",!
+          . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
+          . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^CCRUTIL($P(VITPTMP,U,4),"DT")
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="OTHER VITAL"
+          . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
+          . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
+          . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="UNKNOWN"
+          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="OTHER"
+          . . . ;S @VITVMAP@("VITALSIGNSDESCRIPTIONCODEVALUE")=""
+          . . . ;S @VITVMAP@("VITALSIGNSDESCRIPTIONCODINGSYSTEM")=""
+          . . . ;S @VITVMAP@("VITALSIGNSCODEVERSION")=""
+          . . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P(^GMR(120.5,$P(VITPTMP,U,1),0),U,6)
+          . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3)
+          . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")="UNKNOWN"
+          . . S VITARYTMP=$NA(@VITTARYTMP@(J))
+          . . K @VITARYTMP
+          . . D MAP^GPLXPATH(VITXML,VITVMAP,VITARYTMP)
+          . . I J=1 D  ; FIRST ONE IS JUST A COPY
+          . . . ; W "FIRST ONE",!
+          . . . D CP^GPLXPATH(VITARYTMP,VITOUTXML)
+          . . . W "VITOUTXML ",VITOUTXML,!
+          . . I J>1 D  ; AFTER THE FIRST, INSERT INNER XML
+          . . . D INSINNER^GPLXPATH(VITOUTXML,VITARYTMP)
+          ; ZWR ^TMP($J,"VITALS",*)
+          ZWR ^TMP($J,"VITALARYTMP",*) ; SHOW THE RESULTS
+          I DEBUG D PARY^GPLXPATH(VITOUTXML)
+          N VITTMP,I
+          D MISSING^GPLXPATH(VITOUTXML,"VITTMP") ; SEARCH XML FOR MISSING VARS
+          I VITTMP(0)>0 D  ; IF THERE ARE MISSING VARS - MARKED AS @@X@@
+          . W "VITALS MISSING ",!
+          . F I=1:1:VITTMP(0) W VITTMP(I),!
+          Q
+          ;
Index: r/trunk/p/GPLVITALS.m
===================================================================
--- /ccr/trunk/p/GPLVITALS.m	(revision 110)
+++ 	(revision )
@@ -1,176 +1,0 @@
-GPLVITALS ; CCDCCR/CJE - CCR/CCD PROCESSING FOR VITALS ; 07/16/08
-          ;;0.1;CCDCCR;;JUL 16,2008;
-          ;Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
-          ;General Public License See attached copy of the License.
-          ;
-          ;This program is free software; you can redistribute it and/or modify
-          ;it under the terms of the GNU General Public License as published by
-          ;the Free Software Foundation; either version 2 of the License, or
-          ;(at your option) any later version.
-          ;
-          ;This program is distributed in the hope that it will be useful,
-          ;but WITHOUT ANY WARRANTY; without even the implied warranty of
-          ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-          ;GNU General Public License for more details.
-          ;
-          ;You should have received a copy of the GNU General Public License along
-          ;with this program; if not, write to the Free Software Foundation, Inc.,
-          ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
-          ;
-          W "NO ENTRY FROM TOP",!
-          Q
-          ;
-EXTRACT(VITXML,DFN,VITOUTXML) ; EXTRACT VITALS INTO PROVIDED XML TEMPLATE
-          ;
-          ; VITXML AND OUTXML ARE PASSED BY NAME SO GLOBALS CAN BE USED
-          ; IVITXML WILL CONTAIN ONLY THE VITALS SECTION OF THE OVERALL TEMPLATE
-          ;
-          N VITRSLT,J,K,VITPTMP,X,VITVMAP,TBUF
-          D VITALS^ORQQVI(.VITRSLT,DFN,"","")
-          I $P(VITRSLT(1),U,2)="No vitals found." D  ; NULL RESULT FROM RPC
-          . W "NO VITALS FOUND FROM VITALS RPC",!
-          . S @VITOUTXML@(0)=0
-          . Q
-          ; ZWR RPCRSLT
-          S VITTVMAP=$NA(^TMP("GPLCCR",$J,"VITALS"))
-          S VITTARYTMP=$NA(^TMP("GPLCCR",$J,"VITALARYTMP"))
-          K @VITTVMAP,@VITTARYTMP ; KILL OLD ARRAY VALUES
-          F J=1:1:VITRSLT(1)  D  ; FOR EACH VITAL IN THE LIST
-          . I $D(VITRSLT(J)) D
-          . . S VITVMAP=$NA(@VITTVMAP@(J))
-          . . K @VITVMAP
-          . . I DEBUG W "VMAP= ",VITVMAP,!
-          . . S VITPTMP=VITRSLT(J) ; PULL OUT VITAL FROM RPC RETURN ARRAY
-          . . S @VITVMAP@("VITALSIGNSDATAOBJECTID")="VITAL"_J ; UNIQUE OBJID FOR VITAL
-          . . I $P(VITPTMP,U,2)="HT" D
-          . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
-          . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^CCRUTIL($P(VITPTMP,U,4),"DT")
-          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="HEIGHT"
-          . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
-          . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
-          . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="OBSERVED"
-          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="HEIGHT"
-          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODEVALUE")="248327008"
-          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODINGSYSTEM")="SNOMED"
-          . . . S @VITVMAP@("VITALSIGNSCODEVERSION")=""
-          . . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P(^GMR(120.5,$P(VITPTMP,U,1),0),U,6)
-          . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3)
-          . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")="in"
-          . . E  I $P(VITPTMP,U,2)="WT" D
-          . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
-          . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^CCRUTIL($P(VITPTMP,U,4),"DT")
-          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="WEIGHT"
-          . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
-          . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
-          . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="OBSERVED"
-          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="WEIGHT"
-          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODEVALUE")="107647005"
-          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODINGSYSTEM")="SNOMED"
-          . . . S @VITVMAP@("VITALSIGNSCODEVERSION")=""
-          . . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P(^GMR(120.5,$P(VITPTMP,U,1),0),U,6)
-          . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3)
-          . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")="lbs"
-          . . E  I $P(VITPTMP,U,2)="BP" D
-          . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
-          . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^CCRUTIL($P(VITPTMP,U,4),"DT")
-          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="BLOOD PRESSURE"
-          . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
-          . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
-          . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="OBSERVED"
-          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="BLOOD PRESSURE"
-          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODEVALUE")="392570002"
-          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODINGSYSTEM")="SNOMED"
-          . . . S @VITVMAP@("VITALSIGNSCODEVERSION")=""
-          . . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P(^GMR(120.5,$P(VITPTMP,U,1),0),U,6)
-          . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3)
-          . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")=""
-          . . E  I $P(VITPTMP,U,2)="T" D
-          . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
-          . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^CCRUTIL($P(VITPTMP,U,4),"DT")
-          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="TEMPERATURE"
-          . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
-          . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
-          . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="OBSERVED"
-          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="TEMPERATURE"
-          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODEVALUE")="309646008"
-          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODINGSYSTEM")="SNOMED"
-          . . . S @VITVMAP@("VITALSIGNSCODEVERSION")=""
-          . . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P(^GMR(120.5,$P(VITPTMP,U,1),0),U,6)
-          . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3)
-          . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")="F"
-          . . E  I $P(VITPTMP,U,2)="R" D
-          . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
-          . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^CCRUTIL($P(VITPTMP,U,4),"DT")
-          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="RESPIRATION"
-          . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
-          . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
-          . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="OBSERVED"
-          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="RESPIRATION"
-          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODEVALUE")="366147009"
-          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODINGSYSTEM")="SNOMED"
-          . . . S @VITVMAP@("VITALSIGNSCODEVERSION")=""
-          . . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P(^GMR(120.5,$P(VITPTMP,U,1),0),U,6)
-          . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3)
-          . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")=""
-          . . E  I $P(VITPTMP,U,2)="P" D
-          . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
-          . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^CCRUTIL($P(VITPTMP,U,4),"DT")
-          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="PULSE"
-          . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
-          . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
-          . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="OBSERVED"
-          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="PULSE"
-          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODEVALUE")="366199006"
-          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODINGSYSTEM")="SNOMED"
-          . . . S @VITVMAP@("VITALSIGNSCODEVERSION")=""
-          . . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P(^GMR(120.5,$P(VITPTMP,U,1),0),U,6)
-          . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3)
-          . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")=""
-          . . E  I $P(VITPTMP,U,2)="PN" D
-          . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
-          . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^CCRUTIL($P(VITPTMP,U,4),"DT")
-          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="PAIN"
-          . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
-          . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
-          . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="OBSERVED"
-          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="PAIN"
-          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODEVALUE")="22253000"
-          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONCODINGSYSTEM")="SNOMED"
-          . . . S @VITVMAP@("VITALSIGNSCODEVERSION")=""
-          . . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P(^GMR(120.5,$P(VITPTMP,U,1),0),U,6)
-          . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3)
-          . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")=""
-          . . E  D
-          . . . ;W "IN VITAL:  OTHER",!
-          . . . S @VITVMAP@("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
-          . . . S @VITVMAP@("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^CCRUTIL($P(VITPTMP,U,4),"DT")
-          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="OTHER VITAL"
-          . . . S @VITVMAP@("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
-          . . . S @VITVMAP@("VITALSIGNSTESTOBJECTID")="VITALTEST"_J
-          . . . S @VITVMAP@("VITALSIGNSTESTTYPETEXT")="UNKNOWN"
-          . . . S @VITVMAP@("VITALSIGNSDESCRIPTIONTEXT")="OTHER"
-          . . . ;S @VITVMAP@("VITALSIGNSDESCRIPTIONCODEVALUE")=""
-          . . . ;S @VITVMAP@("VITALSIGNSDESCRIPTIONCODINGSYSTEM")=""
-          . . . ;S @VITVMAP@("VITALSIGNSCODEVERSION")=""
-          . . . S @VITVMAP@("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P(^GMR(120.5,$P(VITPTMP,U,1),0),U,6)
-          . . . S @VITVMAP@("VITALSIGNSTESTRESULTVALUE")=$P(VITPTMP,U,3)
-          . . . S @VITVMAP@("VITALSIGNSTESTRESULTUNIT")="UNKNOWN"
-          . . S VITARYTMP=$NA(@VITTARYTMP@(J))
-          . . K @VITARYTMP
-          . . D MAP^GPLXPATH(VITXML,VITVMAP,VITARYTMP)
-          . . I J=1 D  ; FIRST ONE IS JUST A COPY
-          . . . ; W "FIRST ONE",!
-          . . . D CP^GPLXPATH(VITARYTMP,VITOUTXML)
-          . . . W "VITOUTXML ",VITOUTXML,!
-          . . I J>1 D  ; AFTER THE FIRST, INSERT INNER XML
-          . . . D INSINNER^GPLXPATH(VITOUTXML,VITARYTMP)
-          ; ZWR ^TMP($J,"VITALS",*)
-          ZWR ^TMP($J,"VITALARYTMP",*) ; SHOW THE RESULTS
-          I DEBUG D PARY^GPLXPATH(VITOUTXML)
-          N VITTMP,I
-          D MISSING^GPLXPATH(VITOUTXML,"VITTMP") ; SEARCH XML FOR MISSING VARS
-          I VITTMP(0)>0 D  ; IF THERE ARE MISSING VARS - MARKED AS @@X@@
-          . W "VITALS MISSING ",!
-          . F I=1:1:VITTMP(0) W VITTMP(I),!
-          Q
-          ;