Changeset 175 for ccr/trunk/p/GPLACTOR.m
- Timestamp:
- Oct 3, 2008, 10:57:33 PM (16 years ago)
- File:
-
- 1 edited
-
ccr/trunk/p/GPLACTOR.m (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
ccr/trunk/p/GPLACTOR.m
r141 r175 1 1 GPLACTOR ; CCDCCR/GPL - CCR/CCD PROCESSING FOR ACTORS ; 7/3/08 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. 2 ;;0.4;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. 5 19 ; 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. 20 ; PROCESS THE ACTORS SECTION OF THE CCR 10 21 ; 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. 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 26 ; 0.4 Patient data rouine refactored; adjustments here--SMH 15 27 ; 16 ;You should have received a copy of the GNU General Public License along17 ;with this program; if not, write to the Free Software Foundation, Inc.,18 ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.19 ;20 ; PROCESS THE ACTORS SECTION OF THE CCR21 ;22 ; ===Revision History===23 ; 0.1 Initial Writing of Skeleton--GPL24 ; 0.2 Patient Data Extraction--SMH25 ; 0.3 Information System Info Extraction--SMH26 ;27 28 EXTRACT(IPXML,ALST,AXML) ; EXTRACT ACTOR FROM ALST INTO PROVIDED XML TEMPLATE 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 29 ; IPXML is the Input Actor Template into which we substitute values 30 ; This is straight XML. Values to be substituted are in @@VAL@@ format. 31 ; ALST is the actor list global generated by ACTLST^GPLCCR and has 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 ; AXML is the output arrary, to contain XML. 36 ; 37 N I,J,AMAP,AOID,ATYP,AIEN 38 D CP^GPLXPATH(IPXML,AXML) ; MAKE A COPY OF ACTORS XML 39 D REPLACE^GPLXPATH(AXML,"","//Actors") ; DELETE THE INSIDES 40 I DEBUG W "PROCESSING ACTORS ",! 41 F I=1:1:@ALST@(0) D ; PROCESS ALL ACTORS IN THE LIST 42 . I @ALST@(I)["@@" Q ; NOT A VALID ACTOR 43 . S AOID=$P(@ALST@(I),"^",1) ; ACTOR OBJECT ID 44 . S ATYP=$P(@ALST@(I),"^",2) ; ACTOR TYPE 45 . S AIEN=$P(@ALST@(I),"^",3) ; ACTOR RECORD NUMBER 46 . I ATYP="" Q ; NOT A VALID ACTOR 47 . ; 48 . I DEBUG W AOID_" "_ATYP_" "_AIEN,! 49 . I ATYP="PATIENT" D ; PATIENT ACTOR TYPE 50 . . D QUERY^GPLXPATH(IPXML,"//Actors/ACTOR-PATIENT","ATMP") 51 . . D PATIENT("ATMP",AIEN,AOID,"ATMP2") 52 . ; 53 . I ATYP="SYSTEM" D ; SYSTEM ACTOR TYPE 54 . . D QUERY^GPLXPATH(IPXML,"//Actors/ACTOR-SYSTEM","ATMP") 55 . . D SYSTEM("ATMP",AIEN,AOID,"ATMP2") 56 . ; 57 . I ATYP="NOK" D ; NOK ACTOR TYPE 58 . . D QUERY^GPLXPATH(IPXML,"//Actors/ACTOR-NOK","ATMP") 59 . . D NOK("ATMP",AIEN,AOID,"ATMP2") 60 . ; 61 . I ATYP="PROVIDER" D ; PROVIDER ACTOR TYPE 62 . . D QUERY^GPLXPATH(IPXML,"//Actors/ACTOR-PROVIDER","ATMP") 63 . . D PROVIDER("ATMP",AIEN,AOID,"ATMP2") 64 . ; 65 . I ATYP="ORGANIZATION" D ; PROVIDER ACTOR TYPE 66 . . D QUERY^GPLXPATH(IPXML,"//Actors/ACTOR-ORG","ATMP") 67 . . D ORG("ATMP",AIEN,AOID,"ATMP2") 68 . ; 69 . D INSINNER^GPLXPATH(AXML,"ATMP2") ; INSERT INTO ROOT 70 ; 71 N ACTTMP 72 D MISSING^GPLXPATH(AXML,"ACTTMP") ; SEARCH XML FOR MISSING VARS 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),! 77 Q 78 ; 78 79 PATIENT(INXML,AIEN,AOID,OUTXML) ; PROCESS A PATIENT ACTOR 79 ; 80 I DEBUG W "PROCESSING ACTOR PATIENT ",AIEN,! 81 N AMAP,ZX 82 S AMAP=$NA(^TMP($J,"AMAP")) 83 K @AMAP 84 D INIT^CCRDPT(AIEN) 85 S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID 86 S @AMAP@("ACTORGIVENNAME")=$$GIVEN^CCRDPT 87 S @AMAP@("ACTORMIDDLENAME")=$$MIDDLE^CCRDPT 88 S @AMAP@("ACTORFAMILYNAME")=$$FAMILY^CCRDPT 89 S @AMAP@("ACTORDATEOFBIRTH")=$$DOB^CCRDPT 90 S @AMAP@("ACTORGENDER")=$$GENDER^CCRDPT 91 S @AMAP@("ACTORSSN")="" 92 S @AMAP@("ACTORSSNTEXT")="" 93 S @AMAP@("ACTORSSNSOURCEID")="" 94 S ZX=$$SSN^CCRDPT 95 I ZX'="" D ; IF THERE IS A SSN IN THE RECORD 96 . S @AMAP@("ACTORSSN")=ZX 97 . S @AMAP@("ACTORSSNTEXT")="SSN" 98 . S @AMAP@("ACTORSSNSOURCEID")=AOID 99 S @AMAP@("ACTORADDRESSTYPE")=$$ADDRTYPE^CCRDPT 100 S @AMAP@("ACTORADDRESSLINE1")=$$ADDR1^CCRDPT 101 S @AMAP@("ACTORADDRESSLINE2")=$$ADDR2^CCRDPT 102 S @AMAP@("ACTORADDRESSCITY")=$$CITY^CCRDPT 103 S @AMAP@("ACTORADDRESSSTATE")=$$STATE^CCRDPT 104 S @AMAP@("ACTORADDRESSZIPCODE")=$$ZIP^CCRDPT 105 S @AMAP@("ACTORRESTEL")="" 106 S @AMAP@("ACTORRESTELTEXT")="" 107 S ZX=$$RESTEL^CCRDPT 108 I ZX'="" D ; IF THERE IS A RESIDENT PHONE IN THE RECORD 109 . S @AMAP@("ACTORRESTEL")=ZX 110 . S @AMAP@("ACTORRESTELTEXT")="Residential Telephone" 111 S @AMAP@("ACTORWORKTEL")="" 112 S @AMAP@("ACTORWORKTELTEXT")="" 113 S ZX=$$WORKTEL^CCRDPT 114 I ZX'="" D ; IF THERE IS A RESIDENT PHONE IN THE RECORD 115 . S @AMAP@("ACTORWORKTEL")=ZX 116 . S @AMAP@("ACTORWORKTELTEXT")="Work Telephone" 117 S @AMAP@("ACTORCELLTEL")="" 118 S @AMAP@("ACTORCELLTELTEXT")="" 119 S ZX=$$CELLTEL^CCRDPT 120 I ZX'="" D ; IF THERE IS A CELL PHONE IN THE RECORD 121 . S @AMAP@("ACTORCELLTEL")=ZX 122 . S @AMAP@("ACTORCELLTELTEXT")="Cell Phone" 123 S @AMAP@("ACTOREMAIL")=$$EMAIL^CCRDPT 124 S @AMAP@("ACTORADDRESSSOURCEID")=AOID 125 S @AMAP@("ACTORIEN")=AIEN 126 S @AMAP@("ACTORSUFFIXNAME")="" ; DOES VISTA STORE THE SUFFIX 127 S @AMAP@("ACTORSOURCEID")="ACTORSYSTEM_1" ; THE SYSTEM IS THE SOURCE 128 D DESTROY^CCRDPT 129 D MAP^GPLXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE 130 Q 131 ; 80 I DEBUG W "PROCESSING ACTOR PATIENT ",AIEN,! 81 N AMAP,ZX 82 S AMAP=$NA(^TMP($J,"AMAP")) 83 K @AMAP 84 S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID 85 S @AMAP@("ACTORGIVENNAME")=$$GIVEN^CCRDPT(AIEN) 86 S @AMAP@("ACTORMIDDLENAME")=$$MIDDLE^CCRDPT(AIEN) 87 S @AMAP@("ACTORFAMILYNAME")=$$FAMILY^CCRDPT(AIEN) 88 S @AMAP@("ACTORDATEOFBIRTH")=$$DOB^CCRDPT(AIEN) 89 S @AMAP@("ACTORGENDER")=$$GENDER^CCRDPT(AIEN) 90 S @AMAP@("ACTORSSN")="" 91 S @AMAP@("ACTORSSNTEXT")="" 92 S @AMAP@("ACTORSSNSOURCEID")="" 93 S ZX=$$SSN^CCRDPT(AIEN) 94 I ZX'="" D ; IF THERE IS A SSN IN THE RECORD 95 . S @AMAP@("ACTORSSN")=ZX 96 . S @AMAP@("ACTORSSNTEXT")="SSN" 97 . S @AMAP@("ACTORSSNSOURCEID")=AOID 98 S @AMAP@("ACTORADDRESSTYPE")=$$ADDRTYPE^CCRDPT(AIEN) 99 S @AMAP@("ACTORADDRESSLINE1")=$$ADDR1^CCRDPT(AIEN) 100 S @AMAP@("ACTORADDRESSLINE2")=$$ADDR2^CCRDPT(AIEN) 101 S @AMAP@("ACTORADDRESSCITY")=$$CITY^CCRDPT(AIEN) 102 S @AMAP@("ACTORADDRESSSTATE")=$$STATE^CCRDPT(AIEN) 103 S @AMAP@("ACTORADDRESSZIPCODE")=$$ZIP^CCRDPT(AIEN) 104 S @AMAP@("ACTORRESTEL")="" 105 S @AMAP@("ACTORRESTELTEXT")="" 106 S ZX=$$RESTEL^CCRDPT(AIEN) 107 I ZX'="" D ; IF THERE IS A RESIDENT PHONE IN THE RECORD 108 . S @AMAP@("ACTORRESTEL")=ZX 109 . S @AMAP@("ACTORRESTELTEXT")="Residential Telephone" 110 S @AMAP@("ACTORWORKTEL")="" 111 S @AMAP@("ACTORWORKTELTEXT")="" 112 S ZX=$$WORKTEL^CCRDPT(AIEN) 113 I ZX'="" D ; IF THERE IS A RESIDENT PHONE IN THE RECORD 114 . S @AMAP@("ACTORWORKTEL")=ZX 115 . S @AMAP@("ACTORWORKTELTEXT")="Work Telephone" 116 S @AMAP@("ACTORCELLTEL")="" 117 S @AMAP@("ACTORCELLTELTEXT")="" 118 S ZX=$$CELLTEL^CCRDPT(AIEN) 119 I ZX'="" D ; IF THERE IS A CELL PHONE IN THE RECORD 120 . S @AMAP@("ACTORCELLTEL")=ZX 121 . S @AMAP@("ACTORCELLTELTEXT")="Cell Phone" 122 S @AMAP@("ACTOREMAIL")=$$EMAIL^CCRDPT(AIEN) 123 S @AMAP@("ACTORADDRESSSOURCEID")=AOID 124 S @AMAP@("ACTORIEN")=AIEN 125 S @AMAP@("ACTORSUFFIXNAME")="" ; DOES VISTA STORE THE SUFFIX 126 S @AMAP@("ACTORSOURCEID")="ACTORSYSTEM_1" ; THE SYSTEM IS THE SOURCE 127 D MAP^GPLXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE 128 Q 129 ; 132 130 SYSTEM(INXML,AIEN,AOID,OUTXML) ; PROCESS A SYSTEM ACTOR 133 131 ;
Note:
See TracChangeset
for help on using the changeset viewer.
