iSharkFly-Open
/
VistA-ccr
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

XINDEX fixes. almost clean except for long var names and big files

This commit is contained in:
george 2008-08-30 19:13:15 +00:00
parent 0333b2585b
commit 7fb48ee324
14 changed files with 202 additions and 245 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
p/CCRDPT.m
View File

@ -16,12 +16,10 @@ CCRDPT ;CCRCCD/SMH - Routines to Extract Patient Data for CCDCCR; 6/15/08
;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.
; 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
@ -87,9 +85,8 @@ CCRDPT ;CCRCCD/SMH - Routines to Extract Patient Data for CCDCCR; 6/15/08
; 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
; The following is a map of the relevant data in the patient global.
;
; ^DPT(D0,0)= (#.01) NAME [1F] ^ (#.02) SEX [2S] ^ (#.03) DATE OF BIRTH [3D] ^
@ -163,14 +160,12 @@ CCRDPT ;CCRCCD/SMH - Routines to Extract Patient Data for CCDCCR; 6/15/08
; ==>^ (#.336) E-CITY [6F] ^ (#.337) E-STATE [7P:5] ^ (#.338) E-ZIP
; ==>CODE [8F] ^ (#.339) E-PHONE NUMBER [9F] ^ (#.3305) E-EMER.
; ==>CONTACT SAME AS NOK? [10S] ^ (#.33011) E-WORK PHONE NUMBER
; ==>[11F] ^
INIT(DFN) ; Copy DFN global to a local variable; PUBLIC
; ==>[11F] ^DFN) ; Copy DFN global to a local variable; PUBLIC
; INPUT: Patient IEN (DFN)
; OUTPUT: PT in the Symbol Table, representing the patient global
; Instead of accessing a global each single read (SLOOOOW)
; read it off a local variable stored in Memory.
INIT(DFN) ;
M PT=^DPT(DFN)
Q
;

7
p/CCRDPTT.m
View File

@ -1,4 +1,5 @@
CCRDPTT ; Unit Tester...
;;0.1;CCRCCD;;Jun 15, 2008;
;
;Copyright 2008 WorldVistA. Licensed under the terms of the GNU
;General Public License See attached copy of the License.
@ -26,16 +27,16 @@ CCRDPTT ; Unit Tester...
; 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
; 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 "

7
p/CCRSYS.m
View File

@ -18,18 +18,17 @@ CCRSYS ;CCDCCR/SMH - Routine to Get EHR System Information;6JUL2008
;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
;
W "Enter at appropriate points." Q
;
; Originally, I was going to use VEPERVER, but VEPERVER
; actually kills ^TMP($J), outputs it to the screen in a user-friendly
; manner (press any key to continue),
; and is really a very half finished routine
;
; So for now, I am hard-coding the values.
;
SYSNAME() ;Get EHR System Name; PUBLIC; Extrinsic
Q "WorldVistA EHR/VOE"
;
SYSVER() ;Get EHR System Version; PUBLIC; Extrinsic
Q "1.0"
;

1
p/CCRUNIT.m
View File

@ -1,4 +1,5 @@
CCRUNIT ; A routine that tests some crap
;;0.1;CCDCCR;;JUL 13, 2007;Build 0
Q
;
MEDS

4
p/CCRUTIL.m
View File

@ -69,8 +69,8 @@ SORTDT(V1,V2,ORDR) ; DATE SORT ARRAY AND RETURN INDEX IN V1 AND COUNT
. . ; S VSRT($P(V2(ZTMP),U,4)_"000000"_ZCNT)=ZCNT ; PULL DATE
. I DEBUG W "ZTMP=",ZTMP," "
S V1(0)=ZCNT ; ARRAYS ARE THE SAME SIZE
I DEBUG ZWR V2
I DEBUG ZWR VSRT
; I DEBUG ZWR V2
; I DEBUG ZWR VSRT
N ZD,ZT ; DATA AND TIME ITERATORS
N ZDONE ; DONE FLAG
S (ZD,ZT)=""

11
p/CCRVA200.m
View File

@ -19,9 +19,9 @@ CCRVA200 ;WV/CCDCCR/SMH - Routine to get Provider Data;07/13/2008
Q
; This routine uses Kernel APIs and Direct Global Access to get
; Proivder Data from File 200.
;
; The Global is VA(200,*)
;
FAMILY(DUZ) ; Get Family Name; PUBLIC; EXTRINSIC
; INPUT: DUZ (i.e. File 200 IEN) ByVal
; OUTPUT: String
@ -75,7 +75,7 @@ SPEC(DUZ) ; Get Provider Specialty, PUBLIC; EXTRINSIC
; OUTPUT: String: ProviderType/Specialty/Subspecialty OR ""
; Uses a Kernel API. Returns -1 if a specialty is not specified
; in file 200.
; Otherwise, returns IEN^Profession^Specialty^Sub­ specialty^Effect date^Expired date^VA code
; Otherwise, returns IEN^Profession^Specialty^Sub­specialty^Effect date^Expired date^VA code
N STR S STR=$$GET^XUA4A72(DUZ)
Q:+STR<0 ""
; Sometimes we have 3 pieces, or 2. Deal with that.
@ -90,11 +90,11 @@ ADDTYPE(DUZ) ; Get Address Type, PUBLIC; EXTRINSIC
ADDLINE1(DUZ) ; Get Address associated with this instituation; PUBLIC; EXTRINSIC
; INPUT: DUZ ByVal
; Output: String.
;
; First, get site number from the institution file.
; 1st piece returned by $$SITE^VASITE, which gets the system institution
N INST S INST=$P($$SITE^VASITE(),U)
;
; Second, get mailing address
; There are two APIs to get the address, one for physical and one for
; mailing. We will check if mailing exists first, since that's the
@ -165,4 +165,3 @@ EMAIL(DUZ) ; Get Provider's Email. PUBLIC; EXTRINSIC
N EMAIL S EMAIL=$G(^VA(200,DUZ,.15))
Q $P(EMAIL,U)
;

4
p/GPLCCD.m
View File

@ -86,7 +86,7 @@ CCDRPC(CCRGRTN,DFN,CCRPART,TIME1,TIME2,HDRARY) ;RPC ENTRY POINT FOR CCR OUTPUT
K ACTT1 K ACCT2
; MAPPING THE PROVIDER ORGANIZATION,AUTHOR,INFORMANT,CUSTODIAN CDA HEADER
; FOR NOW, THEY ARE ALL THE SAME AND RESOLVE TO ORGANIZATION
D ORG^GPLACTORS(CCDGLO,DFN,"ACTORPATIENTORGANIZATION","ACTT2") ; MAP ORG
D ORG^GPLACTOR(CCDGLO,DFN,"ACTORPATIENTORGANIZATION","ACTT2") ; MAP ORG
D CP^GPLXPATH("ACTT2",CCDGLO)
;
K ^TMP("GPLCCR",$J,"CCRSTEP") ; KILL GLOBAL PRIOR TO ADDING TO IT
@ -115,7 +115,7 @@ CCDRPC(CCRGRTN,DFN,CCRPART,TIME1,TIME2,HDRARY) ;RPC ENTRY POINT FOR CCR OUTPUT
; NEED TO ADD BACK IN ACTOR PROCESSING AFTER WE FIGURE OUT LINKAGE
; D ACTLST^GPLCCR(CCDGLO,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(CCDGLO,"ACTT2","//ContinuityOfCareRecord/Actors")
N I,J,DONE S DONE=0
F I=0:0 D Q:DONE ; DELETE UNTIL ALL EMPTY ELEMENTS ARE GONE

8
p/GPLCCD1.m
View File

@ -1,4 +1,4 @@
GPLCCD0 ; CCDCCR/GPL - CCD TEMPLATE AND ACCESS ROUTINES; 6/7/08
GPLCCD1 ; CCDCCR/GPL - CCD TEMPLATE AND ACCESS ROUTINES; 6/7/08
;;0.1;CCDCCR;nopatch;noreleasedate
;Copyright 2008 WorldVistA. Licensed under the terms of the GNU
;General Public License See attached copy of the License.
@ -25,9 +25,9 @@ ZT(ZARY,BAT,LINE) ; private routine to add a line to the ZARY array
; ZARY IS PASSED BY NAME
; BAT is a string identifying the section
; LINE is a test which will evaluate to true or false
; I '$G(@ZARY) D
. S @ZARY@(0)=0 ; initially there are no elements
. W "GOT HERE LOADING "_LINE,!
; I '$G(@ZARY) D ; IF ZARY DOES NOT EXIST '
; . S @ZARY@(0)=0 ; initially there are no elements
; . W "GOT HERE LOADING "_LINE,!
N CNT ; count of array elements
S CNT=@ZARY@(0) ; contains array count
S CNT=CNT+1 ; increment count

6
p/GPLCCR0.m
View File

@ -25,9 +25,9 @@ ZT(ZARY,BAT,LINE) ; private routine to add a line to the ZARY array
; ZARY IS PASSED BY NAME
; BAT is a string identifying the section
; LINE is a test which will evaluate to true or false
; I '$G(@ZARY) D
. S @ZARY@(0)=0 ; initially there are no elements
. W "GOT HERE LOADING "_LINE,!
; I '$G(@ZARY) D ;
; . S @ZARY@(0)=0 ; initially there are no elements
; . W "GOT HERE LOADING "_LINE,!
N CNT ; count of array elements
S CNT=@ZARY@(0) ; contains array count
S CNT=CNT+1 ; increment count

2
p/GPLMEDS.m
View File

@ -31,7 +31,7 @@ EXTRACT(MEDXML,DFN,MEDOUTXML) ; EXTRACT MEDICATIONS INTO PROVIDED XML TEMPLATE
. W "ERROR RUNNINIG MEDICATIONS RPC",!
. S @MEDOUTXML@(0)=0
. Q
I DEBUG ZWR MEDRSLT
; I DEBUG ZWR MEDRSLT
M GPLMEDS=MEDRSLT
S MEDTVMAP=$NA(^TMP("GPLCCR",$J,"MEDICATIONS"))
S MEDTARYTMP=$NA(^TMP("GPLCCR",$J,"MEDARYTMP"))

2
p/GPLPROBS.m
View File

@ -37,7 +37,7 @@ EXTRACT(IPXML,DFN,OUTXML) ; EXTRACT PROBLEMS INTO PROVIDED XML TEMPLATE
. W "NULL RESULT FROM LIST^ORQQPL3 ",!
. S @OUTXML@(0)=0
. ; Q
I DEBUG ZWR RPCRSLT
; I DEBUG ZWR RPCRSLT
F J=1:1:RPCRSLT(0) D ; FOR EACH PROBLEM IN THE LIST
. S VMAP=$NA(@TVMAP@(J))
. K @VMAP

2
p/GPLUNIT.m
View File

@ -112,7 +112,7 @@ TEST ; RUN ALL THE TEST CASES
W "FAILED: ",TFAILED,!
W !
W "THE TESTS!",!
I DEBUG ZWR ZTMP
; I DEBUG ZWR ZTMP
Q
;
GTSTS(GTZARY,RTN) ; return an array of test names

42
p/GPLVITAL.m
View File

@ -38,7 +38,7 @@ EXTRACT(VITXML,DFN,VITOUTXML) ; EXTRACT VITALS INTO PROVIDED XML TEMPLATE
K @VITTVMAP,@VITTARYTMP ; KILL OLD ARRAY VALUES
N VSORT,VDATES,VCNT ; ARRAY FOR DATE SORTED VITALS INDEX
D VITDATES(.VDATES) ; PULL OUT THE DATES INTO AN ARRAY
I DEBUG ZWR VDATES ;DEBUG
; I DEBUG ZWR VDATES ;DEBUG
S VCNT=$$SORTDT^CCRUTIL(.VSORT,.VDATES,-1) ; PUT VITALS IN REVERSE
; DATE ORDER AND COUNT THEM. VSORT CONTAINS INDIRECT INDEXES ONLY
F J=1:1:VCNT D ; FOR EACH VITAL IN THE LIST
@ -174,7 +174,7 @@ EXTRACT(VITXML,DFN,VITOUTXML) ; EXTRACT VITALS INTO PROVIDED XML TEMPLATE
. . 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
; 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
@ -183,44 +183,6 @@ EXTRACT(VITXML,DFN,VITOUTXML) ; EXTRACT VITALS INTO PROVIDED XML TEMPLATE
. F I=1:1:VITTMP(0) W VITTMP(I),!
Q
;
VITSORT(V1,V2) ; DEPRECATED USE $$RSORTDT^CCRUTIL
; DATE SORT VITALS ARRAY AND RETURN INDEX IN V1 AND COUNT
; AS EXTRINSIC
; BOTH V1 AND V2 ARE PASSED BY REFERENCE
N VSRT ; TEMP FOR HASHING DATES
N ZI,ZJ,ZTMP,ZCNT,ZP1,ZP2
S ZCNT=0 ; COUNTING NUMBER OF VITALS
S ZTMP="" ;
F ZI=0:0 D Q:$O(V2(ZTMP))="" ; FOR EACH VITAL IN THE ARRAY
. S ZCNT=ZCNT+1 ; INCREMENT THE COUNT
. S ZTMP=$O(V2(ZTMP)) ; NEXT VITAL
. I $D(V2(ZTMP)) D ; IF THE RESULT EXISTS
. . S ZP1=$P($P(V2(ZTMP),U,4),".",1) ; THE DATE PIECE
. . S ZP2=$P($P(V2(ZTMP),U,4),".",2) ; THE TIME PIECE
. . S VSRT(ZP1,ZP2_"00000"_ZCNT)=ZCNT ; HASH ON DATE AND TIME
. . ; S VSRT($P(V2(ZTMP),U,4)_"000000"_ZCNT)=ZCNT ; PULL DATE
. I DEBUG W "ZTMP=",ZTMP," "
S V1(0)=ZCNT ; ARRAYS ARE THE SAME SIZE
I DEBUG ZWR V2
I DEBUG ZWR VSRT
N ZD,ZT ; DATA AND TIME ITERATORS
N ZDONE ; DONE FLAG
S (ZD,ZT)=""
S ZDONE=0
N ZZCNT S ZZCNT=0 ; ANOTHER COUNTER
F ZI=0:0 D Q:ZDONE ; VISIT THE ARRAY IN DATE ORDER
. S ZD=$O(VSRT(ZD),-1) ; NEXT DATE
. I ZD="" S ZDONE=1
. I 'ZDONE D ; MORE DATES
. . S ZT="" ; WANT FIRST TIME FOR THIS DATE
. . F ZJ=0:0 D Q:$O(VSRT(ZD,ZT),-1)="" ; LOOP THROUGH ALL TIMES
. . . S ZT=$O(VSRT(ZD,ZT),-1) ; NEXT TIME
. . . S ZZCNT=ZZCNT+1 ; INCREMENT COUNTER
. . . S V1(ZZCNT)=VSRT(ZD,ZT) ; PULL OUT THE INDEX
. ; S V1(ZI)=ZI ; PLUG FOR NOW, DATES NOT SORTED
I DEBUG ZWR V1
Q ZCNT
;
VITDATES(VDT) ; VDT IS PASSED BY REFERENCE AND WILL CONTAIN THE ARRAY
; OF DATES IN THE VITALS RESULTS
N VDTI,VDTJ,VTDCNT