| [37] | 1 | GPLACTORS ; CCDCCR/GPL - CCR/CCD PROCESSING FOR ACTORS ; 7/3/08
|
|---|
| [60] | 2 | ;;0.3;CCDCCR;nopatch;noreleasedate
|
|---|
| 3 | ;Copyright 2008 WorldVistA. Licensed under the terms of the GNU
|
|---|
| 4 | ;General Public License See attached copy of the License.
|
|---|
| 5 | ;
|
|---|
| 6 | ;This program is free software; you can redistribute it and/or modify
|
|---|
| 7 | ;it under the terms of the GNU General Public License as published by
|
|---|
| 8 | ;the Free Software Foundation; either version 2 of the License, or
|
|---|
| 9 | ;(at your option) any later version.
|
|---|
| 10 | ;
|
|---|
| 11 | ;This program is distributed in the hope that it will be useful,
|
|---|
| 12 | ;but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|---|
| 13 | ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|---|
| 14 | ;GNU General Public License for more details.
|
|---|
| 15 | ;
|
|---|
| 16 | ;You should have received a copy of the GNU General Public License along
|
|---|
| 17 | ;with this program; if not, write to the Free Software Foundation, Inc.,
|
|---|
| 18 | ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
|
|---|
| [40] | 19 | ;
|
|---|
| 20 | ; PROCESS THE ACTORS SECTION OF THE CCR
|
|---|
| [57] | 21 | ;
|
|---|
| 22 | ; ===Revision History===
|
|---|
| 23 | ; 0.1 Initial Writing of Skeleton--GPL
|
|---|
| 24 | ; 0.2 Patient Data Extraction--SMH
|
|---|
| 25 | ; 0.3 Information System Info Extraction--SMH
|
|---|
| [40] | 26 | ;
|
|---|
| [45] | 27 | EXTRACT(IPXML,ALST,AXML) ; EXTRACT ACTOR FROM ALST INTO PROVIDED XML TEMPLATE
|
|---|
| [48] | 28 | ; IPXML is the Input Actor Template into which we are going to substitute values
|
|---|
| [57] | 29 | ; This is straight XML. Values to be substituted are in @@VAL@@ format.
|
|---|
| 30 |
|
|---|
| 31 | ; ALST is the actor list global generated by ACTLST^GPLCCR and is in the following format
|
|---|
| 32 | ; ^TMP(7542,1,"ACTORS",0)=Count
|
|---|
| 33 | ; ^TMP(7542,1,"ACTORS",n)="ActorID^ActorType^ActorIEN"
|
|---|
| 34 | ; ActorType is an enum containing either "PROVIDER" "PATIENT" "SYSTEM"
|
|---|
| 35 |
|
|---|
| [48] | 36 | ; AXML is the output arrary, to contain XML.
|
|---|
| 37 |
|
|---|
| [45] | 38 | N I,J,AMAP,AOID,ATYP,AIEN
|
|---|
| 39 | D CP^GPLXPATH(IPXML,AXML) ; MAKE A COPY OF ACTORS XML
|
|---|
| 40 | D REPLACE^GPLXPATH(AXML,"","//Actors") ; DELETE THE INSIDES
|
|---|
| 41 | W "PROCESSING ACTORS ",!
|
|---|
| [37] | 42 | F I=1:1:@ALST@(0) D ; PROCESS ALL ACTORS IN THE LIST
|
|---|
| [48] | 43 | . I @ALST@(I)["@@" Q ; NOT A VALID ACTOR
|
|---|
| [37] | 44 | . S AOID=$P(@ALST@(I),"^",1) ; ACTOR OBJECT ID
|
|---|
| 45 | . S ATYP=$P(@ALST@(I),"^",2) ; ACTOR TYPE
|
|---|
| 46 | . S AIEN=$P(@ALST@(I),"^",3) ; ACTOR RECORD NUMBER
|
|---|
| [48] | 47 | . I ATYP="" Q ; NOT A VALID ACTOR
|
|---|
| [37] | 48 | . ;
|
|---|
| [45] | 49 | . W AOID_" "_ATYP_" "_AIEN,!
|
|---|
| [43] | 50 | . I ATYP="PATIENT" D ; PATIENT ACTOR TYPE
|
|---|
| 51 | . . D QUERY^GPLXPATH(IPXML,"//Actors/ACTOR-PATIENT","ATMP")
|
|---|
| [75] | 52 | . . D PATIENT("ATMP",AIEN,AOID,"ATMP2")
|
|---|
| [37] | 53 | . ;
|
|---|
| [43] | 54 | . I ATYP="SYSTEM" D ; SYSTEM ACTOR TYPE
|
|---|
| 55 | . . D QUERY^GPLXPATH(IPXML,"//Actors/ACTOR-SYSTEM","ATMP")
|
|---|
| [75] | 56 | . . D SYSTEM("ATMP",AIEN,AOID,"ATMP2")
|
|---|
| [37] | 57 | . ;
|
|---|
| [43] | 58 | . I ATYP="NOK" D ; NOK ACTOR TYPE
|
|---|
| 59 | . . D QUERY^GPLXPATH(IPXML,"//Actors/ACTOR-NOK","ATMP")
|
|---|
| [75] | 60 | . . D NOK("ATMP",AIEN,AOID,"ATMP2")
|
|---|
| [37] | 61 | . ;
|
|---|
| [43] | 62 | . I ATYP="PROVIDER" D ; PROVIDER ACTOR TYPE
|
|---|
| 63 | . . D QUERY^GPLXPATH(IPXML,"//Actors/ACTOR-PROVIDER","ATMP")
|
|---|
| [75] | 64 | . . D PROVIDER("ATMP",AIEN,AOID,"ATMP2")
|
|---|
| [43] | 65 | . ;
|
|---|
| [57] | 66 | . I ATYP="ORGANIZATION" D ; PROVIDER ACTOR TYPE
|
|---|
| 67 | . . D QUERY^GPLXPATH(IPXML,"//Actors/ACTOR-ORG","ATMP")
|
|---|
| [75] | 68 | . . D ORG("ATMP",AIEN,AOID,"ATMP2")
|
|---|
| [57] | 69 | . ;
|
|---|
| [45] | 70 | . D INSINNER^GPLXPATH(AXML,"ATMP2") ; INSERT INTO ROOT
|
|---|
| [37] | 71 | ;
|
|---|
| [45] | 72 | D MISSING^GPLXPATH(AXML,"ACTTMP") ; SEARCH XML FOR MISSING VARS
|
|---|
| [43] | 73 | I ACTTMP(0)>0 D ; IF THERE ARE MISSING VARS -
|
|---|
| 74 | . ; STRINGS MARKED AS @@X@@
|
|---|
| 75 | . W "ACTORS Missing list: ",!
|
|---|
| 76 | . F I=1:1:ACTTMP(0) W ACTTMP(I),!
|
|---|
| [37] | 77 | Q
|
|---|
| 78 | ;
|
|---|
| [75] | 79 | PATIENT(INXML,AIEN,AOID,OUTXML) ; PROCESS A PATIENT ACTOR
|
|---|
| [43] | 80 | ;
|
|---|
| [75] | 81 | W "PROCESSING ACTOR PATIENT ",AIEN,!
|
|---|
| [45] | 82 | ; N AMAP
|
|---|
| 83 | S AMAP=$NA(^TMP($J,"AMAP"))
|
|---|
| [75] | 84 | K @AMAP
|
|---|
| [57] | 85 | D INIT^CCRDPT(AIEN)
|
|---|
| [43] | 86 | S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
|
|---|
| [48] | 87 | S @AMAP@("ACTORGIVENNAME")=$$GIVEN^CCRDPT
|
|---|
| 88 | S @AMAP@("ACTORMIDDLENAME")=$$MIDDLE^CCRDPT
|
|---|
| 89 | S @AMAP@("ACTORFAMILYNAME")=$$FAMILY^CCRDPT
|
|---|
| 90 | S @AMAP@("ACTORDATEOFBIRTH")=$$DOB^CCRDPT
|
|---|
| 91 | S @AMAP@("ACTORGENDER")=$$GENDER^CCRDPT
|
|---|
| 92 | S @AMAP@("ACTORSSN")=$$SSN^CCRDPT
|
|---|
| 93 | S @AMAP@("ACTORSSNSOURCEID")=AOID
|
|---|
| 94 | S @AMAP@("ACTORADDRESSTYPE")=$$ADDRTYPE^CCRDPT
|
|---|
| 95 | S @AMAP@("ACTORADDRESSLINE1")=$$ADDR1^CCRDPT
|
|---|
| 96 | S @AMAP@("ACTORADDRESSLINE2")=$$ADDR2^CCRDPT
|
|---|
| 97 | S @AMAP@("ACTORADDRESSCITY")=$$CITY^CCRDPT
|
|---|
| 98 | S @AMAP@("ACTORADDRESSSTATE")=$$STATE^CCRDPT
|
|---|
| 99 | S @AMAP@("ACTORADDRESSZIPCODE")=$$ZIP^CCRDPT
|
|---|
| 100 | S @AMAP@("ACTORRESTEL")=$$RESTEL^CCRDPT
|
|---|
| 101 | S @AMAP@("ACTORWORKTEL")=$$WORKTEL^CCRDPT
|
|---|
| [57] | 102 | S @AMAP@("ACTORCELLTEL")=$$CELLTEL^CCRDPT
|
|---|
| [48] | 103 | S @AMAP@("ACTOREMAIL")=$$EMAIL^CCRDPT
|
|---|
| 104 | S @AMAP@("ACTORADDRESSSOURCEID")=AOID
|
|---|
| [75] | 105 | S @AMAP@("ACTORIEN")=AIEN
|
|---|
| 106 | S @AMAP@("ACTORSUFFIXNAME")="" ; DOES VISTA STORE THE SUFFIX?
|
|---|
| [57] | 107 | D DESTROY^CCRDPT
|
|---|
| [43] | 108 | D MAP^GPLXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
|
|---|
| 109 | Q
|
|---|
| 110 | ;
|
|---|
| [75] | 111 | SYSTEM(INXML,AIEN,AOID,OUTXML) ; PROCESS A SYSTEM ACTOR
|
|---|
| [43] | 112 | ;
|
|---|
| [45] | 113 | ; N AMAP
|
|---|
| 114 | S AMAP=$NA(^TMP($J,"AMAP"))
|
|---|
| [75] | 115 | K @AMAP
|
|---|
| [43] | 116 | S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
|
|---|
| [49] | 117 | S @AMAP@("ACTORINFOSYSNAME")=$$SYSNAME^CCRSYS
|
|---|
| [57] | 118 | S @AMAP@("ACTORINFOSYSVER")=$$SYSVER^CCRSYS
|
|---|
| [49] | 119 | S @AMAP@("ACTORINFOSYSSOURCEID")=AOID
|
|---|
| [43] | 120 | D MAP^GPLXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
|
|---|
| 121 | Q
|
|---|
| 122 | ;
|
|---|
| [75] | 123 | NOK(INXML,AIEN,AOID,OUTXML) ; PROCESS A NEXT OF KIN TYPE ACTOR
|
|---|
| [43] | 124 | ;
|
|---|
| [45] | 125 | ; N AMAP
|
|---|
| 126 | S AMAP=$NA(^TMP($J,"AMAP"))
|
|---|
| [75] | 127 | K @AMAP
|
|---|
| [43] | 128 | S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
|
|---|
| 129 | S @AMAP@("ACTORDISPLAYNAME")=""
|
|---|
| 130 | S @AMAP@("ACTORRELATION")=""
|
|---|
| 131 | S @AMAP@("ACTORRELATIONSOURCEID")=""
|
|---|
| 132 | D MAP^GPLXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
|
|---|
| 133 | Q
|
|---|
| 134 | ;
|
|---|
| [75] | 135 | ORG(INXML,AIEN,AOID,OUTXML) ; PROCESS AN ORGANIZATION TYPE ACTOR
|
|---|
| [57] | 136 | ;
|
|---|
| 137 | ; N AMAP
|
|---|
| 138 | S AMAP=$NA(^TMP($J,"AMAP"))
|
|---|
| [75] | 139 | K @AMAP
|
|---|
| [57] | 140 | S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
|
|---|
| [71] | 141 | S @AMAP@("ORGANIZATIONNAME")=$P($$SITE^VASITE,U,2)
|
|---|
| [57] | 142 | S @AMAP@("ACTORSOURCEID")="ACTORSYSTEM_1"
|
|---|
| 143 | D MAP^GPLXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
|
|---|
| 144 | Q
|
|---|
| 145 | ;
|
|---|
| [75] | 146 | PROVIDER(INXML,AIEN,AOID,OUTXML) ; PROCESS A PROVIDER TYPE ACTOR
|
|---|
| [43] | 147 | ;
|
|---|
| [45] | 148 | ; N AMAP
|
|---|
| 149 | S AMAP=$NA(^TMP($J,"AMAP"))
|
|---|
| [75] | 150 | K @AMAP
|
|---|
| [43] | 151 | S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
|
|---|
| [67] | 152 | S @AMAP@("ACTORGIVENNAME")=$$GIVEN^CCRVA200(AIEN)
|
|---|
| 153 | S @AMAP@("ACTORMIDDLENAME")=$$MIDDLE^CCRVA200(AIEN)
|
|---|
| 154 | S @AMAP@("ACTORFAMILYNAME")=$$FAMILY^CCRVA200(AIEN)
|
|---|
| [71] | 155 | S @AMAP@("ACTORTITLE")=$$TITLE^CCRVA200(AIEN)
|
|---|
| 156 | S @AMAP@("IDTYPE")=$P($$NPI^CCRVA200(AIEN),U,1)
|
|---|
| 157 | S @AMAP@("ID")=$P($$NPI^CCRVA200(AIEN),U,2)
|
|---|
| 158 | S @AMAP@("IDDESC")=$P($$NPI^CCRVA200(AIEN),U,3)
|
|---|
| [67] | 159 | S @AMAP@("ACTORSPECIALITY")=$$SPEC^CCRVA200(AIEN)
|
|---|
| 160 | S @AMAP@("ACTORADDRESSTYPE")=$$ADDTYPE^CCRVA200(AIEN)
|
|---|
| 161 | S @AMAP@("ACTORADDRESSLINE1")=$$ADDLINE1^CCRVA200(AIEN)
|
|---|
| 162 | S @AMAP@("ACTORADDRESSCITY")=$$CITY^CCRVA200(AIEN)
|
|---|
| 163 | S @AMAP@("ACTORADDRESSSTATE")=$$STATE^CCRVA200(AIEN)
|
|---|
| 164 | S @AMAP@("ACTORPOSTALCODE")=$$POSTCODE^CCRVA200(AIEN)
|
|---|
| 165 | S @AMAP@("ACTORTELEPHONE")=$$TEL^CCRVA200(AIEN)
|
|---|
| 166 | S @AMAP@("ACTORTELEPHONETYPE")=$$TELTYPE^CCRVA200(AIEN)
|
|---|
| 167 | S @AMAP@("ACTOREMAIL")=$$EMAIL^CCRVA200(AIEN)
|
|---|
| 168 | S @AMAP@("ACTORADDRESSSOURCEID")="ACTORSYSTEM_1"
|
|---|
| [43] | 169 | D MAP^GPLXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
|
|---|
| 170 | Q
|
|---|
| 171 | ;
|
|---|
