Index: ccr/trunk/p/GPLACTOR.m
===================================================================
--- ccr/trunk/p/GPLACTOR.m	(revision 141)
+++ ccr/trunk/p/GPLACTOR.m	(revision 175)
@@ -1,133 +1,131 @@
 GPLACTOR  ; 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.
+ ;;0.4;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.
  ;
- ;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.
+ ;  PROCESS THE ACTORS SECTION OF THE CCR
  ;
- ;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.
+ ; ===Revision History===
+ ; 0.1 Initial Writing of Skeleton--GPL
+ ; 0.2 Patient Data Extraction--SMH
+ ; 0.3 Information System Info Extraction--SMH
+ ; 0.4 Patient data rouine refactored; adjustments here--SMH
  ;
- ;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
-           I DEBUG 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
-           . ;
-           . I DEBUG 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
-           ;
+ ; 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
+ I DEBUG 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
+ . ;
+ . I DEBUG 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
-     ;
-     I DEBUG 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
-     ;
+ I DEBUG W "PROCESSING ACTOR PATIENT ",AIEN,!
+ N AMAP,ZX
+ S AMAP=$NA(^TMP($J,"AMAP"))
+ K @AMAP
+ S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
+ S @AMAP@("ACTORGIVENNAME")=$$GIVEN^CCRDPT(AIEN)
+ S @AMAP@("ACTORMIDDLENAME")=$$MIDDLE^CCRDPT(AIEN)
+ S @AMAP@("ACTORFAMILYNAME")=$$FAMILY^CCRDPT(AIEN)
+ S @AMAP@("ACTORDATEOFBIRTH")=$$DOB^CCRDPT(AIEN)
+ S @AMAP@("ACTORGENDER")=$$GENDER^CCRDPT(AIEN)
+ S @AMAP@("ACTORSSN")=""
+ S @AMAP@("ACTORSSNTEXT")=""
+ S @AMAP@("ACTORSSNSOURCEID")=""
+ S ZX=$$SSN^CCRDPT(AIEN)
+ 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(AIEN)
+ S @AMAP@("ACTORADDRESSLINE1")=$$ADDR1^CCRDPT(AIEN)
+ S @AMAP@("ACTORADDRESSLINE2")=$$ADDR2^CCRDPT(AIEN)
+ S @AMAP@("ACTORADDRESSCITY")=$$CITY^CCRDPT(AIEN)
+ S @AMAP@("ACTORADDRESSSTATE")=$$STATE^CCRDPT(AIEN)
+ S @AMAP@("ACTORADDRESSZIPCODE")=$$ZIP^CCRDPT(AIEN)
+ S @AMAP@("ACTORRESTEL")=""
+ S @AMAP@("ACTORRESTELTEXT")=""
+ S ZX=$$RESTEL^CCRDPT(AIEN)
+ 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(AIEN)
+ 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(AIEN)
+ 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(AIEN)
+ 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 MAP^GPLXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
+ Q
+ ;
 SYSTEM(INXML,AIEN,AOID,OUTXML) ; PROCESS A SYSTEM ACTOR
      ;
