Changeset 508 for ccr/trunk

Timestamp:

May 21, 2009, 1:12:11 PM (16 years ago)

Author:

George Lilly

Message:

formatting for Version 1

Location:

ccr/trunk/p

Files:

• C0CACTOR.m (modified) (7 diffs)
• C0CALERT.m (modified) (3 diffs)
• C0CBAT.m (modified) (12 diffs)
• C0CCCD.m (modified) (11 diffs)
• C0CCCD1.m (modified) (4 diffs)
• C0CCCR.m (modified) (12 diffs)
• C0CCCR0.m (modified) (4 diffs)
• C0CDPT.m (modified) (3 diffs)
• C0CFM1.m (modified) (11 diffs)
• C0CFM2.m (modified) (17 diffs)
• C0CIMMU.m (modified) (3 diffs)
• C0CLA7Q.m (modified) (1 diff)
• C0CLABS.m (modified) (9 diffs)
• C0CMED.m (modified) (1 diff)
• C0CMED1.m (modified) (1 diff)
• C0CMED2.m (modified) (1 diff)
• C0CMED3.m (modified) (2 diffs)
• C0CMED6.m (modified) (1 diff)
• C0CPARMS.m (modified) (1 diff)
• C0CPROBS.m (modified) (2 diffs)
• C0CQRY2.m (added)
• C0CRIMA.m (modified) (25 diffs)
• C0CRNF.m (modified) (15 diffs)
• C0CRXN.m (modified) (8 diffs)
• C0CSUB1.m (modified) (10 diffs)
• C0CSYS.m (modified) (2 diffs)
• C0CUNIT.m (modified) (10 diffs)
• C0CUTIL.m (modified) (1 diff)
• C0CVA200.m (modified) (2 diffs)
• C0CVITAL.m (modified) (3 diffs)
• C0CVOBX1.m (added)
• C0CXPAT0.m (modified) (1 diff)
• C0CXPATH.m (modified) (27 diffs)
• LA7QRY1.m (modified) (1 diff)

ccr/trunk/p/C0CACTOR.m

@@ -1 @@
-C0CACTOR  ; CCDCCR/GPL - CCR/CCD PROCESSING FOR ACTORS ; 7/3/08
- ;;0.4;CCDCCR;nopatch;noreleasedate
+C0CACTOR         ; CCDCCR/GPL - CCR/CCD PROCESSING FOR ACTORS ; 7/3/08
+ ;;1.0;C0C;;May 19, 2009;
  ;Copyright 2008,2009 George Lilly, University of Minnesota.
  ;Licensed under the terms of the GNU General Public License.
@@ -27 +27 @@
  ; 0.4 Patient data rouine refactored; adjustments here--SMH
  ;
-EXTRACT(IPXML,ALST,AXML) ; EXTRACT ACTOR FROM ALST INTO PROVIDED XML TEMPLATE
+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.
@@ -83 +83 @@
  Q
  ;
-PATIENT(INXML,AIEN,AOID,OUTXML) ; PROCESS A PATIENT ACTOR
+PATIENT(INXML,AIEN,AOID,OUTXML) ; PROCESS A PATIENT ACTOR
  I DEBUG W "PROCESSING ACTOR PATIENT ",AIEN,!
  N AMAP,ZX
@@ -142 +142 @@
  Q
  ;
-SYSTEM(INXML,AIEN,AOID,OUTXML) ; PROCESS A SYSTEM ACTOR
+SYSTEM(INXML,AIEN,AOID,OUTXML)  ; PROCESS A SYSTEM ACTOR
      ;
      ; N AMAP
@@ -154 +154 @@
      Q
      ;
-NOK(INXML,AIEN,AOID,OUTXML) ; PROCESS A NEXT OF KIN TYPE ACTOR
+NOK(INXML,AIEN,AOID,OUTXML)     ; PROCESS A NEXT OF KIN TYPE ACTOR
      ;
      ; N AMAP
@@ -167 +167 @@
      Q
      ;
-ORG(INXML,AIEN,AOID,OUTXML) ; PROCESS AN ORGANIZATION TYPE ACTOR
+ORG(INXML,AIEN,AOID,OUTXML)     ; PROCESS AN ORGANIZATION TYPE ACTOR
      ;
      ; N AMAP
@@ -178 +178 @@
      Q
      ;
-PROVIDER(INXML,AIEN,AOID,OUTXML) ; PROCESS A PROVIDER TYPE ACTOR
+PROVIDER(INXML,AIEN,AOID,OUTXML)        ; PROCESS A PROVIDER TYPE ACTOR
      ;
      ; N AMAP

ccr/trunk/p/C0CALERT.m

@@ -1 @@
-C0CALERT  ; CCDCCR/CKU/GPL - CCR/CCD PROCESSING FOR ALERTS ; 09/11/08
- ;;0.1;CCDCCR;;SEP 11,2008;
+C0CALERT         ; CCDCCR/CKU/GPL - CCR/CCD PROCESSING FOR ALERTS ; 09/11/08
+ ;;1.0;C0C;;May 19, 2009;
  ;Copyright 2008,2009 George Lilly, University of Minnesota and others.
  ;Licensed under the terms of the GNU General Public License.
@@ -22 +22 @@
  Q
  ;
-EXTRACT(ALTXML,DFN,ALTOUTXML) ; EXTRACT ALERTS INTO PROVIDED XML TEMPLATE
+EXTRACT(ALTXML,DFN,ALTOUTXML)   ; EXTRACT ALERTS INTO PROVIDED XML TEMPLATE
  ;
  ; ALTXML AND ALTOUTXML ARE PASSED BY NAME SO GLOBALS CAN BE USED
@@ -118 +118 @@
  S @ALTTVMAP@(0)=ALTCNT-1 ; RECORD THE NUMBER OF ALERTS
  Q
-PRSGLB(INGLB) ; EXTRINSIC TO PARSE GLOBALS AND RETURN THE FILE NUMBER
+PRSGLB(INGLB)   ; EXTRINSIC TO PARSE GLOBALS AND RETURN THE FILE NUMBER
  ; INGLB IS OF THE FORM: PSNDF(50.6,
  ; RETURN 50.6

ccr/trunk/p/C0CBAT.m

@@ -1 @@
-C0CBAT   ; CCDCCR/GPL - CCR Batch utilities; 4/21/09
- ;;0.1;CCDCCR;nopatch;noreleasedate
+C0CBAT    ; CCDCCR/GPL - CCR Batch utilities; 4/21/09
+ ;;1.0;C0C;;May 19, 2009;
  ;Copyright 2009 George Lilly.  Licensed under the terms of the GNU
  ;General Public License See attached copy of the License.
@@ -21 +21 @@
  Q
  ;
-STOP ; STOP A CURRENTLY RUNNING BATCH JOB
+STOP    ; STOP A CURRENTLY RUNNING BATCH JOB
  I '$D(^TMP("C0CBAT","RUNNING")) Q  ;
  W !,!,"HALTING CCR BATCH",!
@@ -33 +33 @@
  Q
  ;
-START ; STARTS A TAKSMAN CCR BATCH JOB - FOR USE IN A MENU OPTION
+START   ; STARTS A TAKSMAN CCR BATCH JOB - FOR USE IN A MENU OPTION
  ;
  I $D(^TMP("C0CBAT","RUNNING")) D  Q  ; ONLY ONE ALLOWED AT A TIME
@@ -48 +48 @@
  Q
  ;
-EN ; BATCH ENTRY POINT
+EN      ; BATCH ENTRY POINT
  ; PROCESSES THE SUBSCRIPTION FILE, EXTRACTING CCR VARIABLES FOR EACH
  ; PATIENT WITH AN ACTIVE SUBSCRIPTION, AND IF CHECKSUMS INDICATE A CHANGE,
@@ -146 +146 @@
  Q
  ;
-BLDHOT(ZHB) ; BUILD HOT LIST AT GLOBAL ZHB, PASSED BY NAME
+BLDHOT(ZHB)     ; BUILD HOT LIST AT GLOBAL ZHB, PASSED BY NAME
  ; SEARCHS FOR PATIENTS IN THE "AC" INDEX OF THE ORDER FILE
  N ZDFN
@@ -156 +156 @@
  Q
  ;
-COUNT(ZB) ; EXTRINSIC THAT RETURNS THE NUMBER OF ARRAY ELEMENTS
+COUNT(ZB)       ; EXTRINSIC THAT RETURNS THE NUMBER OF ARRAY ELEMENTS
  N ZI,ZN
  S ZN=0
@@ -164 +164 @@
  Q ZN
  ;
-UPDIEVARPTR(ZVAR,ZTYP) ;EXTRINSIC WHICH RETURNS THE POINTER TO ZVAR IN THE
+UPDIEVARPTR(ZVAR,ZTYP)  ;EXTRINSIC WHICH RETURNS THE POINTER TO ZVAR IN THE
  ; CCR DICTIONARY. IT IS LAYGO, AS IT WILL ADD THE VARIABLE TO
  ; THE CCR DICTIONARY IF IT IS NOT THERE. ZTYP IS REQUIRED FOR LAYGO
@@ -186 +186 @@
  Q ZVARN
  ;
-UPDIE ; INTERNAL ROUTINE TO CALL UPDATE^DIE AND CHECK FOR ERRORS
+UPDIE   ; INTERNAL ROUTINE TO CALL UPDATE^DIE AND CHECK FOR ERRORS
  K ZERR
  D CLEAN^DILF
@@ -197 +197 @@
  Q
  ;
-SETFDA(C0CSN,C0CSV) ; INTERNAL ROUTINE TO MAKE AN FDA ENTRY FOR FIELD C0CSN
+SETFDA(C0CSN,C0CSV)     ; INTERNAL ROUTINE TO MAKE AN FDA ENTRY FOR FIELD C0CSN
  ; TO SET TO VALUE C0CSV.
  ; C0CFDA,C0CC,C0CZX ARE ASSUMED FROM THE CALLING ROUTINE
@@ -207 +207 @@
  S C0CFDA(C0CSI,C0CZX_",",C0CSJ)=C0CSV
  Q
-ZFILE(ZFN,ZTAB) ; EXTRINSIC TO RETURN FILE NUMBER FOR FIELD NAME PASSED
+ZFILE(ZFN,ZTAB) ; EXTRINSIC TO RETURN FILE NUMBER FOR FIELD NAME PASSED
  ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 1 OF C0CA(ZFN)
  ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA
@@ -215 +215 @@
  E  S ZR=""
  Q ZR
-ZFIELD(ZFN,ZTAB) ;EXTRINSIC TO RETURN FIELD NUMBER FOR FIELD NAME PASSED
+ZFIELD(ZFN,ZTAB)        ;EXTRINSIC TO RETURN FIELD NUMBER FOR FIELD NAME PASSED
  ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 2 OF C0CA(ZFN)
  ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA
@@ -224 +224 @@
  Q ZR
  ;
-ZVALUE(ZFN,ZTAB) ;EXTRINSIC TO RETURN VALUE FOR FIELD NAME PASSED
+ZVALUE(ZFN,ZTAB)        ;EXTRINSIC TO RETURN VALUE FOR FIELD NAME PASSED
  ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 3 OF C0CA(ZFN)
  ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA

ccr/trunk/p/C0CCCD.m

@@ -1 @@
-C0CCCD   ; CCDCCR/GPL - CCD MAIN PROCESSING; 6/6/08
- ;;0.1;CCDCCR;nopatch;noreleasedate
+C0CCCD    ; CCDCCR/GPL - CCD MAIN PROCESSING; 6/6/08
+ ;;1.0;C0C;;May 19, 2009;
  ;Copyright 2008,2009 George Lilly, University of Minnesota.
  ;Licensed under the terms of the GNU General Public License.
@@ -21 +21 @@
  ; EXPORT A CCR
  ;
-EXPORT   ; EXPORT ENTRY POINT FOR CCR
+EXPORT    ; EXPORT ENTRY POINT FOR CCR
        ; Select a patient.
        S DIC=2,DIC(0)="AEMQ" D ^DIC
@@ -29 +29 @@
        Q
        ;
-XPAT(DFN,DIR,FN) ; EXPORT ONE PATIENT TO A FILE
+XPAT(DFN,DIR,FN)        ; EXPORT ONE PATIENT TO A FILE
        ; DIR IS THE DIRECTORY, DEFAULTS IF NULL TO ^TMP("C0CCCR","ODIR")
        ; FN IS FILE NAME, DEFAULTS IF NULL
@@ -49 +49 @@
        Q
        ;
-CCDRPC(CCRGRTN,DFN,CCRPART,TIME1,TIME2,HDRARY)  ;RPC ENTRY POINT FOR CCR OUTPUT
+CCDRPC(CCRGRTN,DFN,CCRPART,TIME1,TIME2,HDRARY)   ;RPC ENTRY POINT FOR CCR OUTPUT
     ; CCRGRTN IS RETURN ARRAY PASSED BY NAME
     ; DFN IS PATIENT IEN
@@ -146 +146 @@
     Q
     ;
-INITSTPS(TAB)  ; INITIALIZE CCR PROCESSING STEPS
+INITSTPS(TAB)    ; INITIALIZE CCR PROCESSING STEPS
     ; TAB IS PASSED BY NAME
     W "TAB= ",TAB,!
@@ -155 +155 @@
     Q
     ;
-SHAVE(SHXML) ; REMOVES THE 2-6 AND N-1 AND N-2 LINES FROM A COMPONENT
+SHAVE(SHXML)    ; REMOVES THE 2-6 AND N-1 AND N-2 LINES FROM A COMPONENT
     ; NEEDED TO EXPOSE THE REPEATING PARTS FOR GENERATION
     N SHTMP,SHBLD ; TEMP ARRAY AND BUILD LIST
@@ -168 +168 @@
     Q
     ;
-UNSHAVE(ORIGXML,SHXML) ; REPLACES THE 2-6 AND N-1 AND N-2 LINES FROM TEMPLATE
+UNSHAVE(ORIGXML,SHXML)  ; REPLACES THE 2-6 AND N-1 AND N-2 LINES FROM TEMPLATE
     ; NEEDED TO RESTORM FIXED TOP AND BOTTOM OF THE COMPONENT XML
     N SHTMP,SHBLD ; TEMP ARRAY AND BUILD LIST
@@ -181 +181 @@
     Q
     ;
-HDRMAP(CXML,DFN,IHDR)   ; MAP HEADER VARIABLES: FROM, TO ECT
+HDRMAP(CXML,DFN,IHDR)     ; MAP HEADER VARIABLES: FROM, TO ECT
     N VMAP S VMAP=$NA(^TMP("C0CCCR",$J,DFN,"HEADER"))
     ; K @VMAP
@@ -200 +200 @@
     Q
     ;
-ACTLST(AXML,ACTRTN) ; RETURN THE ACTOR LIST FOR THE XML IN AXML
+ACTLST(AXML,ACTRTN)     ; RETURN THE ACTOR LIST FOR THE XML IN AXML
     ; AXML AND ACTRTN ARE PASSED BY NAME
     ; EACH ACTOR RECORD HAS 3 PARTS - IE IF OBJECTID=ACTORPATIENT_2
@@ -225 +225 @@
     Q
     ;
-TEST ; RUN ALL THE TEST CASES
+TEST    ; RUN ALL THE TEST CASES
   D TESTALL^C0CUNIT("C0CCCR")
   Q
   ;
-ZTEST(WHICH)  ; RUN ONE SET OF TESTS
+ZTEST(WHICH)     ; RUN ONE SET OF TESTS
   N ZTMP
   D ZLOAD^C0CUNIT("ZTMP","C0CCCR")
@@ -235 +235 @@
   Q
   ;
-TLIST  ; LIST THE TESTS
+TLIST    ; LIST THE TESTS
   N ZTMP
   D ZLOAD^C0CUNIT("ZTMP","C0CCCR")

ccr/trunk/p/C0CCCD1.m

@@ -1 @@
-C0CCCD1 ; CCDCCR/GPL - CCD TEMPLATE AND ACCESS ROUTINES; 6/7/08
- ;;0.1;CCDCCR;nopatch;noreleasedate
+C0CCCD1 ; CCDCCR/GPL - CCD TEMPLATE AND ACCESS ROUTINES; 6/7/08
+ ;;1.0;C0C;;May 19, 2009;
  ;Copyright 2008,2009 George Lilly, University of Minnesota.
  ;Licensed under the terms of the GNU General Public License.
@@ -23 +23 @@
           Q
           ;
-ZT(ZARY,BAT,LINE) ; private routine to add a line to the ZARY array
+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
@@ -38 +38 @@
           Q
           ;
-ZLOAD(ZARY,ROUTINE) ; load tests into ZARY which is passed by reference
+ZLOAD(ZARY,ROUTINE)     ; load tests into ZARY which is passed by reference
           ; ZARY IS PASSED BY NAME
           ; ZARY = name of the root, closed array format (e.g., "^TMP($J)")
@@ -58 +58 @@
           Q
           ;
-LOAD(ARY) ; LOAD A CCR TEMPLATE INTO ARY PASSED BY NAME
+LOAD(ARY)       ; LOAD A CCR TEMPLATE INTO ARY PASSED BY NAME
           D ZLOAD(ARY,"C0CCCD1")
           ; ZWR @ARY
           Q
           ;
-TRMCCD    ; ROUTINE TO BE WRITTEN TO REMOVE CCR MARKUP FROM CCD
-          Q
-MARKUP ;<MARKUP>
+TRMCCD     ; ROUTINE TO BE WRITTEN TO REMOVE CCR MARKUP FROM CCD
+          Q
+MARKUP  ;<MARKUP>
  ;;<Body>
  ;;<Problems>

ccr/trunk/p/C0CCCR.m

@@ -1 @@
-C0CCCR   ; CCDCCR/GPL - CCR MAIN PROCESSING; 6/6/08
- ;;0.1;CCDCCR;nopatch;noreleasedate
+C0CCCR    ; CCDCCR/GPL - CCR MAIN PROCESSING; 6/6/08
+ ;;1.0;C0C;;May 19, 2009;
  ;Copyright 2008,2009 George Lilly, University of Minnesota.
  ;Licensed under the terms of the GNU General Public License.
@@ -21 +21 @@
  ; EXPORT A CCR
  ;
-EXPORT   ; EXPORT ENTRY POINT FOR CCR
+EXPORT    ; EXPORT ENTRY POINT FOR CCR
  ; Select a patient.
  S DIC=2,DIC(0)="AEMQ" D ^DIC
@@ -29 +29 @@
  Q
  ;
-XPAT(DFN,XPARMS,DIR,FN) ; EXPORT ONE PATIENT TO A FILE
+XPAT(DFN,XPARMS,DIR,FN) ; EXPORT ONE PATIENT TO A FILE
  ; DIR IS THE DIRECTORY, DEFAULTS IF NULL TO ^TMP("C0CCCR","ODIR")
  ; FN IS FILE NAME, DEFAULTS IF NULL
@@ -41 +41 @@
  S OARY=$NA(^TMP("C0CCCR",$J,DFN,"CCR",1))
  S ONAM=UFN
- I UFN="" S ONAM="PAT_"_DFN_"_CCR_V1_0_22.xml"
+ I UFN="" S ONAM="PAT_"_DFN_"_CCR_V1_0_0.xml"
  S ODIRGLB=$NA(^TMP("C0CCCR","ODIR"))
  S ^TMP("C0CCCR","FNAME",DFN)=ONAM ; FILE NAME FOR BATCH USE
@@ -57 +57 @@
  Q
  ;
-DCCR(DFN) ; DISPLAY A CCR THAT HAS JUST BEEN EXTRACTED
+DCCR(DFN)       ; DISPLAY A CCR THAT HAS JUST BEEN EXTRACTED
  ;
  N G1
@@ -66 +66 @@
  Q
  ;
-CCRRPC(CCRGRTN,DFN,CCRPARMS,CCRPART)  ;RPC ENTRY POINT FOR CCR OUTPUT
+CCRRPC(CCRGRTN,DFN,CCRPARMS,CCRPART)     ;RPC ENTRY POINT FOR CCR OUTPUT
  ; CCRGRTN IS RETURN ARRAY PASSED BY NAME
  ; DFN IS PATIENT IEN
@@ -131 +131 @@
  Q
  ;
-INITSTPS(TAB)  ; INITIALIZE CCR PROCESSING STEPS
+INITSTPS(TAB)    ; INITIALIZE CCR PROCESSING STEPS
  ; TAB IS PASSED BY NAME
  I DEBUG W "TAB= ",TAB,!
@@ -143 +143 @@
  Q
  ;
-HDRMAP(CXML,DFN) ; MAP HEADER VARIABLES: FROM, TO ECT
+HDRMAP(CXML,DFN)        ; MAP HEADER VARIABLES: FROM, TO ECT
  N VMAP S VMAP=$NA(^TMP("C0CCCR",$J,DFN,"HEADER"))
  ; K @VMAP
@@ -167 +167 @@
  Q
  ;
-ACTLST(AXML,ACTRTN) ; RETURN THE ACTOR LIST FOR THE XML IN AXML
+ACTLST(AXML,ACTRTN)     ; RETURN THE ACTOR LIST FOR THE XML IN AXML
  ; AXML AND ACTRTN ARE PASSED BY NAME
  ; EACH ACTOR RECORD HAS 3 PARTS - IE IF OBJECTID=ACTORPATIENT_2
@@ -192 +192 @@
  Q
  ;
-TEST ; RUN ALL THE TEST CASES
+TEST    ; RUN ALL THE TEST CASES
  D TESTALL^C0CUNIT("C0CCCR")
  Q
  ;
-ZTEST(WHICH)  ; RUN ONE SET OF TESTS
+ZTEST(WHICH)     ; RUN ONE SET OF TESTS
  N ZTMP
  D ZLOAD^C0CUNIT("ZTMP","C0CCCR")
@@ -202 +202 @@
  Q
  ;
-TLIST  ; LIST THE TESTS
+TLIST    ; LIST THE TESTS
  N ZTMP
  D ZLOAD^C0CUNIT("ZTMP","C0CCCR")
@@ -238 +238 @@
  ;;>>>D CCRRPC^C0CCCR(.C0C,"2","ALERTS","")
  ;;>>?@C0C@(@C0C@(0))["</Alerts>"
-
+ 

ccr/trunk/p/C0CCCR0.m

@@ -1 @@
-C0CCCR0 ; CCDCCR/GPL - CCR TEMPLATE AND ACCESS ROUTINES; 5/31/08
- ;;0.1;CCDCCR;nopatch;noreleasedate
+C0CCCR0 ; CCDCCR/GPL - CCR TEMPLATE AND ACCESS ROUTINES; 5/31/08
+ ;;1.0;C0C;;May 19, 2009;
  ;Copyright 2008,2009 George Lilly, University of Minnesota.
  ;Licensed under the terms of the GNU General Public License.
@@ -23 +23 @@
  Q
  ;
-ZT(ZARY,BAT,LINE)       ; private routine to add a line to the ZARY array
+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
@@ -38 +38 @@
  Q
  ;
-ZLOAD(ZARY,ROUTINE)      ; load tests into ZARY which is passed by reference
+ZLOAD(ZARY,ROUTINE)          ; load tests into ZARY which is passed by reference
  ; ZARY IS PASSED BY NAME
  ; ZARY = name of the root, closed array format (e.g., "^TMP($J)")
@@ -58 +58 @@
  Q
  ;
-LOAD(ARY)       ; LOAD A CCR TEMPLATE INTO ARY PASSED BY NAME
+LOAD(ARY)             ; LOAD A CCR TEMPLATE INTO ARY PASSED BY NAME
  D ZLOAD(ARY,"C0CCCR0")
  ; ZWR @ARY

ccr/trunk/p/C0CDPT.m

@@ -1 @@
-C0CDPT ;WV/CCRCCD/SMH - Routines to Extract Patient Data for CCDCCR; 6/15/08
- ;;0.2;CCRCCD;;Jun 15, 2008;
+C0CDPT  ;WV/CCRCCD/SMH - Routines to Extract Patient Data for CCDCCR; 6/15/08
+ ;;1.0;C0C;;May 19, 2009;
  ;
  ; Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
@@ -87 +87 @@
  ; You can obtain field numbers using the data dictionary
  ;
-FAMILY(DFN) ; Family Name
- N NAME S NAME=$$GET1^DIQ(2,DFN,.01)
- D NAMECOMP^XLFNAME(.NAME)
- Q NAME("FAMILY")
-GIVEN(DFN) ; Given Name
- N NAME S NAME=$$GET1^DIQ(2,DFN,.01)
- D NAMECOMP^XLFNAME(.NAME)
- Q NAME("GIVEN")
-MIDDLE(DFN) ; Middle Name
- N NAME S NAME=$$GET1^DIQ(2,DFN,.01)
- D NAMECOMP^XLFNAME(.NAME)
- Q NAME("MIDDLE")
-SUFFIX(DFN) ; Suffi Name
- N NAME S NAME=$$GET1^DIQ(2,DFN,.01)
- D NAMECOMP^XLFNAME(.NAME)
- Q NAME("SUFFIX")
-DISPNAME(DFN) ; Display Name
- N NAME S NAME=$$GET1^DIQ(2,DFN,.01)
- ; "G" is Given Name First; "MXc" is Mixed Case, With Suffx Preceded by Comma
- Q $$NAMEFMT^XLFNAME(.NAME,"G","MXc")
-DOB(DFN) ; Date of Birth
+FAMILY(DFN)     ; Family Name
+ N NAME S NAME=$$GET1^DIQ(2,DFN,.01)
+ D NAMECOMP^XLFNAME(.NAME)
+ Q NAME("FAMILY")
+GIVEN(DFN)      ; Given Name
+ N NAME S NAME=$$GET1^DIQ(2,DFN,.01)
+ D NAMECOMP^XLFNAME(.NAME)
+ Q NAME("GIVEN")
+MIDDLE(DFN)     ; Middle Name
+ N NAME S NAME=$$GET1^DIQ(2,DFN,.01)
+ D NAMECOMP^XLFNAME(.NAME)
+ Q NAME("MIDDLE")
+SUFFIX(DFN)     ; Suffi Name
+ N NAME S NAME=$$GET1^DIQ(2,DFN,.01)
+ D NAMECOMP^XLFNAME(.NAME)
+ Q NAME("SUFFIX")
+DISPNAME(DFN)   ; Display Name
+ N NAME S NAME=$$GET1^DIQ(2,DFN,.01)
+ ; "G" is Given Name First; "MXc" is Mixed Case, With Suffx Preceded by Comma
+ Q $$NAMEFMT^XLFNAME(.NAME,"G","MXc")
+DOB(DFN)        ; Date of Birth
  N DOB S DOB=$$GET1^DIQ(2,DFN,.03,"I")
  ; Date in FM Date Format. Convert to UTC/ISO 8601.
  Q $$FMDTOUTC^C0CUTIL(DOB,"D")
-GENDER(DFN) ; Gender/Sex
+GENDER(DFN)     ; Gender/Sex
  Q $$GET1^DIQ(2,DFN,.02) ;
-SSN(DFN) ; SSN
+SSN(DFN)        ; SSN
  Q $$GET1^DIQ(2,DFN,.09)
-ADDRTYPE(DFN) ; Address Type
+ADDRTYPE(DFN)   ; Address Type
  ; Vista only stores a home address for the patient.
  Q "Home"
-ADDR1(DFN) ; Get Home Address line 1
+ADDR1(DFN)      ; Get Home Address line 1
  Q $$GET1^DIQ(2,DFN,.111)
-ADDR2(DFN) ; Get Home Address line 2
+ADDR2(DFN)      ; Get Home Address line 2
  ; Vista has Lines 2,3; CCR has only line 1,2; so compromise
  N ADDLN2,ADDLN3
@@ -126 +126 @@
  Q:ADDLN3="" ADDLN2
  Q ADDLN2_", "_ADDLN3
-CITY(DFN) ; Get City for Home Address
+CITY(DFN)       ; Get City for Home Address
  Q $$GET1^DIQ(2,DFN,.114)
-STATE(DFN) ; Get State for Home Address
+STATE(DFN)      ; Get State for Home Address
  Q $$GET1^DIQ(2,DFN,.115)
-ZIP(DFN) ; Get Zip code for Home Address
+ZIP(DFN)        ; Get Zip code for Home Address
  Q $$GET1^DIQ(2,DFN,.116)
-COUNTY(DFN) ; Get County for our Address
+COUNTY(DFN)     ; Get County for our Address
  Q $$GET1^DIQ(2,DFN,.117)
-COUNTRY(DFN) ; Get Country for our Address
+COUNTRY(DFN)    ; Get Country for our Address
  ; Unfortunately, it's not stored anywhere in Vista, so the inevitable...
  Q "USA"
-RESTEL(DFN) ; Residential Telephone
+RESTEL(DFN)     ; Residential Telephone
  Q $$GET1^DIQ(2,DFN,.131)
-WORKTEL(DFN) ; Work Telephone
+WORKTEL(DFN)    ; Work Telephone
  Q $$GET1^DIQ(2,DFN,.132)
-EMAIL(DFN) ; Email Adddress
+EMAIL(DFN)      ; Email Adddress
  Q $$GET1^DIQ(2,DFN,.133)
-CELLTEL(DFN) ; Cell Phone
+CELLTEL(DFN)    ; Cell Phone
  Q $$GET1^DIQ(2,DFN,.134)
-NOK1FAM(DFN) ; Next of Kin 1 (NOK1) Family Name
- N NAME S NAME=$$GET1^DIQ(2,DFN,.211)
- D NAMECOMP^XLFNAME(.NAME)
- Q NAME("FAMILY")
-NOK1GIV(DFN) ; NOK1 Given Name
- N NAME S NAME=$$GET1^DIQ(2,DFN,.211)
- D NAMECOMP^XLFNAME(.NAME)
- Q NAME("GIVEN")
-NOK1MID(DFN) ; NOK1 Middle Name
- N NAME S NAME=$$GET1^DIQ(2,DFN,.211)
- D NAMECOMP^XLFNAME(.NAME)
- Q NAME("MIDDLE")
-NOK1SUF(DFN) ; NOK1 Suffi Name
- N NAME S NAME=$$GET1^DIQ(2,DFN,.211)
- D NAMECOMP^XLFNAME(.NAME)
- Q NAME("SUFFIX")
-NOK1DISP(DFN) ; NOK1 Display Name
- N NAME S NAME=$$GET1^DIQ(2,DFN,.211)
- ; "G" is Given Name First; "MXc" is Mixed Case, With Suffx Preceded by Comma
- Q $$NAMEFMT^XLFNAME(.NAME,"G","MXc")
-NOK1REL(DFN) ; NOK1 Relationship to the patient
+NOK1FAM(DFN)    ; Next of Kin 1 (NOK1) Family Name
+ N NAME S NAME=$$GET1^DIQ(2,DFN,.211)
+ D NAMECOMP^XLFNAME(.NAME)
+ Q NAME("FAMILY")
+NOK1GIV(DFN)    ; NOK1 Given Name
+ N NAME S NAME=$$GET1^DIQ(2,DFN,.211)
+ D NAMECOMP^XLFNAME(.NAME)
+ Q NAME("GIVEN")
+NOK1MID(DFN)    ; NOK1 Middle Name
+ N NAME S NAME=$$GET1^DIQ(2,DFN,.211)
+ D NAMECOMP^XLFNAME(.NAME)
+ Q NAME("MIDDLE")
+NOK1SUF(DFN)    ; NOK1 Suffi Name
+ N NAME S NAME=$$GET1^DIQ(2,DFN,.211)
+ D NAMECOMP^XLFNAME(.NAME)
+ Q NAME("SUFFIX")
+NOK1DISP(DFN)   ; NOK1 Display Name
+ N NAME S NAME=$$GET1^DIQ(2,DFN,.211)
+ ; "G" is Given Name First; "MXc" is Mixed Case, With Suffx Preceded by Comma
+ Q $$NAMEFMT^XLFNAME(.NAME,"G","MXc")
+NOK1REL(DFN)    ; NOK1 Relationship to the patient
  Q $$GET1^DIQ(2,DFN,.212)
-NOK1ADD1(DFN) ; NOK1 Address 1
+NOK1ADD1(DFN)   ; NOK1 Address 1
  Q $$GET1^DIQ(2,DFN,.213)
-NOK1ADD2(DFN) ; NOK1 Address 2 
+NOK1ADD2(DFN)   ; NOK1 Address 2 
  N ADDLN2,ADDLN3
  S ADDLN2=$$GET1^DIQ(2,DFN,.214),ADDLN3=$$GET1^DIQ(2,DFN,.215)
  Q:ADDLN3="" ADDLN2
  Q ADDLN2_", "_ADDLN3
-NOK1CITY(DFN) ; NOK1 City
+NOK1CITY(DFN)   ; NOK1 City
  Q $$GET1^DIQ(2,DFN,.216)
-NOK1STAT(DFN) ; NOK1 State
+NOK1STAT(DFN)   ; NOK1 State
  Q $$GET1^DIQ(2,DFN,.217)
-NOK1ZIP(DFN) ; NOK1 Zip Code
+NOK1ZIP(DFN)    ; NOK1 Zip Code
  Q $$GET1^DIQ(2,DFN,.218)
-NOK1HTEL(DFN) ; NOK1 Home Telephone
+NOK1HTEL(DFN)   ; NOK1 Home Telephone
  Q $$GET1^DIQ(2,DFN,.219)
-NOK1WTEL(DFN) ; NOK1 Work Telephone
+NOK1WTEL(DFN)   ; NOK1 Work Telephone
  Q $$GET1^DIQ(2,DFN,.21011)
-NOK1SAME(DFN) ; Is NOK1's Address the same the patient?
+NOK1SAME(DFN)   ; Is NOK1's Address the same the patient?
  Q $$GET1^DIQ(2,DFN,.2125)
-NOK2FAM(DFN) ; NOK2 Family Name
- N NAME S NAME=$$GET1^DIQ(2,DFN,.2191)
- D NAMECOMP^XLFNAME(.NAME)
- Q NAME("FAMILY")
-NOK2GIV(DFN) ; NOK2 Given Name
- N NAME S NAME=$$GET1^DIQ(2,DFN,.2191)
- D NAMECOMP^XLFNAME(.NAME)
- Q NAME("GIVEN")
-NOK2MID(DFN) ; NOK2 Middle Name
- N NAME S NAME=$$GET1^DIQ(2,DFN,.2191)
- D NAMECOMP^XLFNAME(.NAME)
- Q NAME("MIDDLE")
-NOK2SUF(DFN) ; NOK2 Suffi Name
- N NAME S NAME=$$GET1^DIQ(2,DFN,.2191)
- D NAMECOMP^XLFNAME(.NAME)
- Q NAME("SUFFIX")
-NOK2DISP(DFN) ; NOK2 Display Name
- N NAME S NAME=$$GET1^DIQ(2,DFN,.2191)
- ; "G" is Given Name First; "MXc" is Mixed Case, With Suffx Preceded by Comma
- Q $$NAMEFMT^XLFNAME(.NAME,"G","MXc")
-NOK2REL(DFN) ; NOK2 Relationship to the patient
+NOK2FAM(DFN)    ; NOK2 Family Name
+ N NAME S NAME=$$GET1^DIQ(2,DFN,.2191)
+ D NAMECOMP^XLFNAME(.NAME)
+ Q NAME("FAMILY")
+NOK2GIV(DFN)    ; NOK2 Given Name
+ N NAME S NAME=$$GET1^DIQ(2,DFN,.2191)
+ D NAMECOMP^XLFNAME(.NAME)
+ Q NAME("GIVEN")
+NOK2MID(DFN)    ; NOK2 Middle Name
+ N NAME S NAME=$$GET1^DIQ(2,DFN,.2191)
+ D NAMECOMP^XLFNAME(.NAME)
+ Q NAME("MIDDLE")
+NOK2SUF(DFN)    ; NOK2 Suffi Name
+ N NAME S NAME=$$GET1^DIQ(2,DFN,.2191)
+ D NAMECOMP^XLFNAME(.NAME)
+ Q NAME("SUFFIX")
+NOK2DISP(DFN)   ; NOK2 Display Name
+ N NAME S NAME=$$GET1^DIQ(2,DFN,.2191)
+ ; "G" is Given Name First; "MXc" is Mixed Case, With Suffx Preceded by Comma
+ Q $$NAMEFMT^XLFNAME(.NAME,"G","MXc")
+NOK2REL(DFN)    ; NOK2 Relationship to the patient
  Q $$GET1^DIQ(2,DFN,.2192)
-NOK2ADD1(DFN) ; NOK2 Address 1
+NOK2ADD1(DFN)   ; NOK2 Address 1
  Q $$GET1^DIQ(2,DFN,.2193)
-NOK2ADD2(DFN) ; NOK2 Address 2
+NOK2ADD2(DFN)   ; NOK2 Address 2
  N ADDLN2,ADDLN3
  S ADDLN2=$$GET1^DIQ(2,DFN,.2194),ADDLN3=$$GET1^DIQ(2,DFN,.2195)
  Q:ADDLN3="" ADDLN2
  Q ADDLN2_", "_ADDLN3
-NOK2CITY(DFN) ; NOK2 City
+NOK2CITY(DFN)   ; NOK2 City
  Q $$GET1^DIQ(2,DFN,.2196)
-NOK2STAT(DFN) ; NOK2 State
+NOK2STAT(DFN)   ; NOK2 State
  Q $$GET1^DIQ(2,DFN,.2197)
-NOK2ZIP(DFN) ; NOK2 Zip Code
+NOK2ZIP(DFN)    ; NOK2 Zip Code
  Q $$GET1^DIQ(2,DFN,.2198)
-NOK2HTEL(DFN) ; NOK2 Home Telephone
+NOK2HTEL(DFN)   ; NOK2 Home Telephone
  Q $$GET1^DIQ(2,DFN,.2199)
-NOK2WTEL(DFN) ; NOK2 Work Telephone
+NOK2WTEL(DFN)   ; NOK2 Work Telephone
  Q $$GET1^DIQ(2,DFN,.211011)
-NOK2SAME(DFN) ; Is NOK2's Address the same the patient?
+NOK2SAME(DFN)   ; Is NOK2's Address the same the patient?
  Q $$GET1^DIQ(2,DFN,.21925)
-EMERFAM(DFN) ; Emergency Contact (EMER) Family Name
- N NAME S NAME=$$GET1^DIQ(2,DFN,.331)
- D NAMECOMP^XLFNAME(.NAME)
- Q NAME("FAMILY")
-EMERGIV(DFN) ; EMER Given Name
- N NAME S NAME=$$GET1^DIQ(2,DFN,.331)
- D NAMECOMP^XLFNAME(.NAME)
- Q NAME("GIVEN")
-EMERMID(DFN) ; EMER Middle Name
- N NAME S NAME=$$GET1^DIQ(2,DFN,.331)
- D NAMECOMP^XLFNAME(.NAME)
- Q NAME("MIDDLE")
-EMERSUF(DFN) ; EMER Suffi Name
- N NAME S NAME=$$GET1^DIQ(2,DFN,.331)
- D NAMECOMP^XLFNAME(.NAME)
- Q NAME("SUFFIX")
-EMERDISP(DFN) ; EMER Display Name
- N NAME S NAME=$$GET1^DIQ(2,DFN,.331)
- ; "G" is Given Name First; "MXc" is Mixed Case, With Suffx Preceded by Comma
- Q $$NAMEFMT^XLFNAME(.NAME,"G","MXc")
-EMERREL(DFN) ; EMER Relationship to the patient
+EMERFAM(DFN)    ; Emergency Contact (EMER) Family Name
+ N NAME S NAME=$$GET1^DIQ(2,DFN,.331)
+ D NAMECOMP^XLFNAME(.NAME)
+ Q NAME("FAMILY")
+EMERGIV(DFN)    ; EMER Given Name
+ N NAME S NAME=$$GET1^DIQ(2,DFN,.331)
+ D NAMECOMP^XLFNAME(.NAME)
+ Q NAME("GIVEN")
+EMERMID(DFN)    ; EMER Middle Name
+ N NAME S NAME=$$GET1^DIQ(2,DFN,.331)
+ D NAMECOMP^XLFNAME(.NAME)
+ Q NAME("MIDDLE")
+EMERSUF(DFN)    ; EMER Suffi Name
+ N NAME S NAME=$$GET1^DIQ(2,DFN,.331)
+ D NAMECOMP^XLFNAME(.NAME)
+ Q NAME("SUFFIX")
+EMERDISP(DFN)   ; EMER Display Name
+ N NAME S NAME=$$GET1^DIQ(2,DFN,.331)
+ ; "G" is Given Name First; "MXc" is Mixed Case, With Suffx Preceded by Comma
+ Q $$NAMEFMT^XLFNAME(.NAME,"G","MXc")
+EMERREL(DFN)    ; EMER Relationship to the patient
  Q $$GET1^DIQ(2,DFN,.331)
-EMERADD1(DFN) ; EMER Address 1
+EMERADD1(DFN)   ; EMER Address 1
  Q $$GET1^DIQ(2,DFN,.333)
-EMERADD2(DFN) ; EMER Address 2
+EMERADD2(DFN)   ; EMER Address 2
  N ADDLN2,ADDLN3
  S ADDLN2=$$GET1^DIQ(2,DFN,.334),ADDLN3=$$GET1^DIQ(2,DFN,.335)
  Q:ADDLN3="" ADDLN2
  Q ADDLN2_", "_ADDLN3
-EMERCITY(DFN) ; EMER City
+EMERCITY(DFN)   ; EMER City
  Q $$GET1^DIQ(2,DFN,.336)
-EMERSTAT(DFN) ; EMER State
+EMERSTAT(DFN)   ; EMER State
  Q $$GET1^DIQ(2,DFN,.337)
-EMERZIP(DFN) ; EMER Zip Code
+EMERZIP(DFN)    ; EMER Zip Code
  Q $$GET1^DIQ(2,DFN,.338)
-EMERHTEL(DFN) ; EMER Home Telephone
+EMERHTEL(DFN)   ; EMER Home Telephone
  Q $$GET1^DIQ(2,DFN,.339)
-EMERWTEL(DFN) ; EMER Work Telephone
+EMERWTEL(DFN)   ; EMER Work Telephone
  Q $$GET1^DIQ(2,DFN,.33011)
-EMERSAME(DFN) ; Is EMER's Address the same the NOK?
+EMERSAME(DFN)   ; Is EMER's Address the same the NOK?
  Q $$GET1^DIQ(2,DFN,.3305)

ccr/trunk/p/C0CFM1.m

@@ -1 @@
-C0CFM1   ; CCDCCR/GPL - CCR FILEMAN utilities; 12/6/08
- ;;0.1;CCDCCR;nopatch;noreleasedate
+C0CFM1    ; CCDCCR/GPL - CCR FILEMAN utilities; 12/6/08
+ ;;1.0;C0C;;May 19, 2009;
  ;Copyright 2009 George Lilly.  Licensed under the terms of the GNU
  ;General Public License See attached copy of the License.
@@ -22 +22 @@
  Q
  ;
-PUTRIM(DFN,ZWHICH) ;DFN IS PATIENT , WHICH IS ELEMENT TYPE
+PUTRIM(DFN,ZWHICH)      ;DFN IS PATIENT , WHICH IS ELEMENT TYPE
  ;
  S C0CGLB=$NA(^TMP("GPLRIM","VARS",DFN))
@@ -37 +37 @@
  Q
  ;
-PUTRIM1(DFN,ZZTYP,ZVARS) ; PUT ONE SECTION OF VARIABLES INTO CCR ELEMENTS
+PUTRIM1(DFN,ZZTYP,ZVARS)        ; PUT ONE SECTION OF VARIABLES INTO CCR ELEMENTS
  ; ZVARS IS PASSED BY NAME AN HAS THE FORM @ZVARS@(1,"VAR1")="VAL1"
  S C0CX=0
@@ -46 +46 @@
  Q
  ;
-PUTELS(DFN,ZTYPE,ZOCC,ZVALS) ; PUT CCR VALUES INTO THE CCR ELEMENTS FILE
+PUTELS(DFN,ZTYPE,ZOCC,ZVALS)    ; PUT CCR VALUES INTO THE CCR ELEMENTS FILE
  ; ^C0C(171.201,   DFN IS THE PATIENT IEN PASSED BY VALUE
  ; ZTYPE IS THE NODE TYPE IE RESULTS,PROBLEMS PASSED BY VALUE
@@ -93 +93 @@
  Q
  ;
-VARPTR(ZVAR,ZTYP) ;EXTRINSIC WHICH RETURNS THE POINTER TO ZVAR IN THE
+VARPTR(ZVAR,ZTYP)       ;EXTRINSIC WHICH RETURNS THE POINTER TO ZVAR IN THE
  ; CCR DICTIONARY. IT IS LAYGO, AS IT WILL ADD THE VARIABLE TO
  ; THE CCR DICTIONARY IF IT IS NOT THERE. ZTYP IS REQUIRED FOR LAYGO
@@ -115 +115 @@
  Q ZVARN
  ;
-BLDTYPS ; ROUTINE TO POPULATE THE CCR NODE TYPES FILE (^C0CDIC(170.101,)
+BLDTYPS ; ROUTINE TO POPULATE THE CCR NODE TYPES FILE (^C0CDIC(170.101,)
  ; THE CCR DICTIONARY (^C0CDIC(170, ) HAS MOST OF WHAT'S NEEDED
  ;
@@ -123 +123 @@
  Q
  ;
-FIXSEC ;FIX THE SECTION FIELD OF THE CCR DICTIONARY.. IT HAS BEEN REDEFINED
+FIXSEC  ;FIX THE SECTION FIELD OF THE CCR DICTIONARY.. IT HAS BEEN REDEFINED
  ; AS A POINTER TO CCR NODE TYPE INSTEAD OF BEING A SET
  ; THE SET VALUES ARE PRESERVED IN ^KBAI("SECTION") TO FACILITATE THIS
@@ -140 +140 @@
  Q
  ;
-SETFDA(C0CSN,C0CSV) ; INTERNAL ROUTINE TO MAKE AN FDA ENTRY FOR FIELD C0CSN
+SETFDA(C0CSN,C0CSV)     ; INTERNAL ROUTINE TO MAKE AN FDA ENTRY FOR FIELD C0CSN
  ; TO SET TO VALUE C0CSV.
  ; C0CFDA,C0CC,C0CZX ARE ASSUMED FROM THE CALLING ROUTINE
@@ -150 +150 @@
  S C0CFDA(C0CSI,C0CZX_",",C0CSJ)=C0CSV
  Q
-ZFILE(ZFN,ZTAB) ; EXTRINSIC TO RETURN FILE NUMBER FOR FIELD NAME PASSED
+ZFILE(ZFN,ZTAB) ; EXTRINSIC TO RETURN FILE NUMBER FOR FIELD NAME PASSED
  ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 1 OF C0CA(ZFN)
  ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA
@@ -158 +158 @@
  E  S ZR=""
  Q ZR
-ZFIELD(ZFN,ZTAB) ;EXTRINSIC TO RETURN FIELD NUMBER FOR FIELD NAME PASSED
+ZFIELD(ZFN,ZTAB)        ;EXTRINSIC TO RETURN FIELD NUMBER FOR FIELD NAME PASSED
  ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 2 OF C0CA(ZFN)
  ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA
@@ -167 +167 @@
  Q ZR
  ;
-ZVALUE(ZFN,ZTAB) ;EXTRINSIC TO RETURN VALUE FOR FIELD NAME PASSED
+ZVALUE(ZFN,ZTAB)        ;EXTRINSIC TO RETURN VALUE FOR FIELD NAME PASSED
  ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 3 OF C0CA(ZFN)
  ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA

ccr/trunk/p/C0CFM2.m

@@ -1 @@
-C0CFM2   ; CCDCCR/GPL - CCR FILEMAN utilities; 12/6/08
- ;;0.1;CCDCCR;nopatch;noreleasedate
+C0CFM2    ; CCDCCR/GPL - CCR FILEMAN utilities; 12/6/08
+ ;;1.0;C0C;;May 19, 2009;
  ;Copyright 2009 George Lilly.  Licensed under the terms of the GNU
  ;General Public License See attached copy of the License.
@@ -28 +28 @@
  Q
  ;
-RIMTBL(ZWHICH) ; PUT ALL PATIENT IN RIMTBL ZWHICH INTO THE CCR ELEMENTS FILE
+RIMTBL(ZWHICH)  ; PUT ALL PATIENT IN RIMTBL ZWHICH INTO THE CCR ELEMENTS FILE
  ;
  I '$D(RIMBASE) D ASETUP^C0CRIMA ; FOR COMMAND LINE CALLS
@@ -39 +39 @@
  Q
  ;
-PUTRIM(DFN,ZWHICH) ;DFN IS PATIENT , WHICH IS ELEMENT TYPE
+PUTRIM(DFN,ZWHICH)      ;DFN IS PATIENT , WHICH IS ELEMENT TYPE
  ;
  S C0CGLB=$NA(^TMP("C0CRIM","VARS",DFN))
@@ -54 +54 @@
  Q
  ;
-PUTRIM1(DFN,ZZTYP,ZVARS) ; PUT ONE SECTION OF VARIABLES INTO CCR ELEMENTS
+PUTRIM1(DFN,ZZTYP,ZVARS)        ; PUT ONE SECTION OF VARIABLES INTO CCR ELEMENTS
  ; ZVARS IS PASSED BY NAME AN HAS THE FORM @ZVARS@(1,"VAR1")="VAL1"
  S C0CX=0
@@ -78 +78 @@
  Q
  ;
-PUTELS(DFN,ZTYPE,ZOCC,ZVALS) ; PUT CCR VALUES INTO THE CCR ELEMENTS FILE
+PUTELS(DFN,ZTYPE,ZOCC,ZVALS)    ; PUT CCR VALUES INTO THE CCR ELEMENTS FILE
  ; 171.101, ^C0CE  DFN IS THE PATIENT IEN PASSED BY VALUE
  ; ZTYPE IS THE NODE TYPE IE RESULTS,PROBLEMS PASSED BY VALUE
@@ -145 +145 @@
  Q
  ;
-UPDIE ; INTERNAL ROUTINE TO CALL UPDATE^DIE AND CHECK FOR ERRORS
+UPDIE   ; INTERNAL ROUTINE TO CALL UPDATE^DIE AND CHECK FOR ERRORS
  K ZERR
  D CLEAN^DILF
@@ -156 +156 @@
  Q
  ;
-CHECK ; CHECKSUM EXPERIMENTS
+CHECK   ; CHECKSUM EXPERIMENTS
  ;
  ;B
@@ -165 +165 @@
  Q
  ;
-CHKELS(DFN) ; CHECKSUM ALL ELEMENTS FOR  A PATIENT
+CHKELS(DFN)     ; CHECKSUM ALL ELEMENTS FOR  A PATIENT
  ;
  S ZGLB=$NA(^TMP("C0CCHK"))
@@ -186 +186 @@
  Q
  ;
-DOIT(DFN) ; EXPERIMENT FOR TIMING CALLS USING mumps -dir DOIT^C0CFM2(DFN)
+DOIT(DFN)       ; EXPERIMENT FOR TIMING CALLS USING mumps -dir DOIT^C0CFM2(DFN)
  D SETXUP
  D CHKELS(DFN)
  Q
  ;
-SETXUP ; SET UP ENVIRONMENT
+SETXUP  ; SET UP ENVIRONMENT
  S DISYS=19
  S DT=3090325
@@ -224 +224 @@
  Q
  ; 
-PUTELSOLD(DFN,ZTYPE,ZOCC,ZVALS) ; PUT CCR VALUES INTO THE CCR ELEMENTS FILE
+PUTELSOLD(DFN,ZTYPE,ZOCC,ZVALS) ; PUT CCR VALUES INTO THE CCR ELEMENTS FILE
  ; 171.101, ^C0CE  DFN IS THE PATIENT IEN PASSED BY VALUE
  ; ZTYPE IS THE NODE TYPE IE RESULTS,PROBLEMS PASSED BY VALUE
@@ -278 +278 @@
  Q
  ;
-VARPTR(ZVAR,ZTYP) ;EXTRINSIC WHICH RETURNS THE POINTER TO ZVAR IN THE
+VARPTR(ZVAR,ZTYP)       ;EXTRINSIC WHICH RETURNS THE POINTER TO ZVAR IN THE
  ; CCR DICTIONARY. IT IS LAYGO, AS IT WILL ADD THE VARIABLE TO
  ; THE CCR DICTIONARY IF IT IS NOT THERE. ZTYP IS REQUIRED FOR LAYGO
@@ -300 +300 @@
  Q ZVARN
  ;
-BLDTYPS ; ROUTINE TO POPULATE THE CCR NODE TYPES FILE (^C0CDIC(170.101,)
+BLDTYPS ; ROUTINE TO POPULATE THE CCR NODE TYPES FILE (^C0CDIC(170.101,)
  ; THE CCR DICTIONARY (^C0CDIC(170, ) HAS MOST OF WHAT'S NEEDED
  ;
@@ -308 +308 @@
  Q
  ;
-FIXSEC ;FIX THE SECTION FIELD OF THE CCR DICTIONARY.. IT HAS BEEN REDEFINED
+FIXSEC  ;FIX THE SECTION FIELD OF THE CCR DICTIONARY.. IT HAS BEEN REDEFINED
  ; AS A POINTER TO CCR NODE TYPE INSTEAD OF BEING A SET
  ; THE SET VALUES ARE PRESERVED IN ^KBAI("SECTION") TO FACILITATE THIS
@@ -325 +325 @@
  Q
  ;
-SETFDA(C0CSN,C0CSV) ; INTERNAL ROUTINE TO MAKE AN FDA ENTRY FOR FIELD C0CSN
+SETFDA(C0CSN,C0CSV)     ; INTERNAL ROUTINE TO MAKE AN FDA ENTRY FOR FIELD C0CSN
  ; TO SET TO VALUE C0CSV.
  ; C0CFDA,C0CC,C0CZX ARE ASSUMED FROM THE CALLING ROUTINE
@@ -335 +335 @@
  S C0CFDA(C0CSI,C0CZX_",",C0CSJ)=C0CSV
  Q
-ZFILE(ZFN,ZTAB) ; EXTRINSIC TO RETURN FILE NUMBER FOR FIELD NAME PASSED
+ZFILE(ZFN,ZTAB) ; EXTRINSIC TO RETURN FILE NUMBER FOR FIELD NAME PASSED
  ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 1 OF C0CA(ZFN)
  ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA
@@ -343 +343 @@
  E  S ZR=""
  Q ZR
-ZFIELD(ZFN,ZTAB) ;EXTRINSIC TO RETURN FIELD NUMBER FOR FIELD NAME PASSED
+ZFIELD(ZFN,ZTAB)        ;EXTRINSIC TO RETURN FIELD NUMBER FOR FIELD NAME PASSED
  ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 2 OF C0CA(ZFN)
  ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA
@@ -352 +352 @@
  Q ZR
  ;
-ZVALUE(ZFN,ZTAB) ;EXTRINSIC TO RETURN VALUE FOR FIELD NAME PASSED
+ZVALUE(ZFN,ZTAB)        ;EXTRINSIC TO RETURN VALUE FOR FIELD NAME PASSED
  ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 3 OF C0CA(ZFN)
  ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA

ccr/trunk/p/C0CIMMU.m

@@ -1 @@
-C0CIMMU ; CCDCCR/GPL - CCR/CCD PROCESSING FOR IMMUNIZATIONS ; 2/2/09
- ;;0.1;CCDCCR;nopatch;noreleasedate;Build 7
+C0CIMMU ; CCDCCR/GPL - CCR/CCD PROCESSING FOR IMMUNIZATIONS ; 2/2/09
+ ;;1.0;C0C;;May 19, 2009;
  ;Copyright 2008,2009 George Lilly, University of Minnesota.
  ;Licensed under the terms of the GNU General Public License.
@@ -22 +22 @@
  ; PROCESS THE IMMUNIZATIONS SECTION OF THE CCR
  ;
-MAP(IPXML,DFN,OUTXML) ; MAP IMMUNIZATIONS
+MAP(IPXML,DFN,OUTXML)   ; MAP IMMUNIZATIONS
  ;
  N C0CZV,C0CZVI ; TO STORE MAPPED VARIABLES
@@ -47 +47 @@
  Q
  ;
-EXTRACT(IPXML,DFN,OUTXML) ; EXTRACT IMMUNIZATIONS INTO VARIABLES
+EXTRACT(IPXML,DFN,OUTXML)       ; EXTRACT IMMUNIZATIONS INTO VARIABLES
  ;
  ; INXML AND OUTXML ARE PASSED BY NAME SO GLOBALS CAN BE USED

ccr/trunk/p/C0CLA7Q.m

@@ -1 +1 @@
 C0CLA7Q ;WV/JMC - CCD/CCR Lab HL7 Query Utility ;May 4, 2009
-        ;;n.n;;****;
-        ;
-        ;
-        Q
-        ;
-        ;
+ ;;1.0;C0C;;May 19, 2009;
+ ;;n.n;;****;
+ ;
+ ;
+ Q
+ ;
+ ;
 LAB(C0CPTID,C0CSDT,C0CEDT,C0CSC,C0CSPEC,C0CERR,C0CDEST,C0CHL7)  ; Entry point for Lab Result Query
-        ;
-        ;
-        K ^TMP("C0C-VLAB",$J)
-        ;
-        ; Check and retrieve lab results from LAB DATA file (#63)
-        S C0CDEST=$$GCPR^LA7QRY($G(C0CPTID),$G(C0CSDT),$G(C0CEDT),.C0CSC,.C0CSPEC,.C0CERR,$G(C0CDEST),$G(C0CHL7))
-        ;
-        ; If V LAB file present then check for lab results that are only in this file
-        ; If results found in V Lab file then build results and add to above results.
-        I $D(^AUPNVLAB) D
-        . D VCHECK
-        . I $D(^TMP("C0C-VLAB",$J,3)) D VBUILD
-        ;
-        ;K ^TMP("C0C-VLAB",$J)
-        ;
-        Q C0CDEST
-        ;
-        ;
+ ;
+ ;
+ K ^TMP("C0C-VLAB",$J)
+ ;
+ ; Check and retrieve lab results from LAB DATA file (#63)
+ S C0CDEST=$$GCPR^LA7QRY($G(C0CPTID),$G(C0CSDT),$G(C0CEDT),.C0CSC,.C0CSPEC,.C0CERR,$G(C0CDEST),$G(C0CHL7))
+ ;
+ ; If V LAB file present then check for lab results that are only in this file
+ ; If results found in V Lab file then build results and add to above results.
+ I $D(^AUPNVLAB) D
+ . D VCHECK
+ . I $D(^TMP("C0C-VLAB",$J,3)) D VBUILD
+ ;
+ ;K ^TMP("C0C-VLAB",$J)
+ ;
+ Q C0CDEST
+ ;
+ ;
 VCHECK  ; If V LAB file present then check for lab results that are only in this file.
-        ;
-        N C0CDA,C0CEND,C0CROOT,C0CVLAB,LA7PTID,LA7SC,LA7SCRC,LA7SPEC
-        ;
-        S LA7PTID=C0CPTID
-        D PATID^LA7QRY2
-        I $D(LA7ERR) Q
-        ;
-        ; Resolve search codes to lab datanames
-        S LA7SC=$G(C0CSC)
-        I $T(SCLIST^LA7QRY2)'="" D
-        . N TMP
-        . S LA7SCSRC=$G(C0CSC)
-        . S TMP=$$SCLIST^LA7QRY2(LA7SCSRC)
-        . S LA7SC=TMP
-        ;
-        I LA7SC'="*" D CHKSC^LA7QRY1
-        ;
-        ; Convert specimen codes to file #61 Topography entries
-        S LA7SPEC=$G(C0CSPEC)
-        I LA7SPEC'="*"  D SPEC^LA7QRY1
-        ;
-        S C0CROOT="^AUPNVLAB(""ALR4"",DFN,C0CSDT)",C0CEND=0
-        ;
-        F  S C0CROOT=$Q(@C0CROOT) Q:C0CROOT=""  D  Q:C0CEND
-        . I $QS(C0CROOT,1)'="ALR4"!($QS(C0CROOT,2)'=DFN) S C0CEND=1 Q  ; Left x-ref or patient
-        . I $QS(C0CROOT,3)>C0CEDT S C0CEND=1 Q  ; Exceeded end date/time
-        . S C0CDA=$QS(C0CROOT,4)
-        . I $D(^TMP("C0C-VLAB",$J,1,C0CDA)) Q  ; Already checked during scan of file #63
-        . I $P($G(^AUPNVLAB(C0CDA,11)),"^",8)=1 Q  ; Source is LAB DATA file - skip
-        . D VCHK1
-        ;
-        ;
-        Q
-        ;
-        ;
+ ;
+ N C0CDA,C0CEND,C0CROOT,C0CVLAB,LA7PTID,LA7SC,LA7SCRC,LA7SPEC
+ ;
+ S LA7PTID=C0CPTID
+ D PATID^LA7QRY2
+ I $D(LA7ERR) Q
+ ;
+ ; Resolve search codes to lab datanames
+ S LA7SC=$G(C0CSC)
+ I $T(SCLIST^LA7QRY2)'="" D
+ . N TMP
+ . S LA7SCSRC=$G(C0CSC)
+ . S TMP=$$SCLIST^LA7QRY2(LA7SCSRC)
+ . S LA7SC=TMP
+ ;
+ I LA7SC'="*" D CHKSC^LA7QRY1
+ ;
+ ; Convert specimen codes to file #61 Topography entries
+ S LA7SPEC=$G(C0CSPEC)
+ I LA7SPEC'="*"  D SPEC^LA7QRY1
+ ;
+ S C0CROOT="^AUPNVLAB(""ALR4"",DFN,C0CSDT)",C0CEND=0
+ ;
+ F  S C0CROOT=$Q(@C0CROOT) Q:C0CROOT=""  D  Q:C0CEND
+ . I $QS(C0CROOT,1)'="ALR4"!($QS(C0CROOT,2)'=DFN) S C0CEND=1 Q  ; Left x-ref or patient
+ . I $QS(C0CROOT,3)>C0CEDT S C0CEND=1 Q  ; Exceeded end date/time
+ . S C0CDA=$QS(C0CROOT,4)
+ . I $D(^TMP("C0C-VLAB",$J,1,C0CDA)) Q  ; Already checked during scan of file #63
+ . I $P($G(^AUPNVLAB(C0CDA,11)),"^",8)=1 Q  ; Source is LAB DATA file - skip
+ . D VCHK1
+ ;
+ ;
+ Q
+ ;
+ ;
 VBUILD  ; Build results found only in V LAB file into HL7 structure.
-        ;
-        ;
-        Q
-        ;
-        ;
+ ;
+ ;
+ Q
+ ;
+ ;
 LNCHK   ; Check for corresponding entry in V LAB file and related LOINC code for a result in file #63.
-        ; Call from LA7QRY2
-        ;
-        N DFN,C0C60,C0C63,C0CACC,C0CDA,C0CDT,C0CLN,C0CPDA,C0CPTEST,C0CSPEC,C0CTEST,X
-        ;
-        S DFN=$P(^LR(LRDFN,0),"^",3)
-        S C0C63(0)=^LR(LRDFN,LRSS,LRIDT,0)
-        S C0CDT=$P(C0C63(0),"^"),C0CACC=$P(C0C63(0),"^",6),C0CSPEC=$P(C0C63(0),"^",5)
-        S (C0CTEST,C0CTEST(64),C0CPTEST,C0CPTEST(64),C0CLN)=""
-        ;
-        ; ^AUPNVLAB("ALR1",5380,"EKT 0307 48",173,3080307.211055,5427197)=""
-        ;
-        S C0C60=""
-        F  S C0C60=$O(^LAB(60,"C",LRSS_";"_LRSB_";1",C0C60)) Q:'C0C60  D  Q:C0CLN'=""
-        . D FINDDT
-        . I C0CDA<1 Q
-        . I $P($G(^AUPNVLAB(C0CDA,11)),"^",8)'=1 Q  ; Source is not LAB DATA file - skip
-        . S C0CLN=$P($G(^AUPNVLAB(C0CDA,11)),"^",13)
-        . S C0CPDA=$P($G(^AUPNVLAB(C0CDA,12)),"^",8)
-        . I C0CPDA="" S C0CPDA=C0CDA
-        . S C0CTEST=$P($G(^AUPNVLAB(C0CDA,0)),"^"),X=$P($G(^LAB(60,C0CTEST,64)),"^",2)
-        . I X S C0CTEST(64)=$P($G(^LAM(X,0)),"^",2)
-        . S C0CPTEST=$P($G(^AUPNVLAB(C0CPDA,0)),"^"),X=$P($G(^LAB(60,C0CPTEST,64)),"^")
-        . I X S C0CPTEST(64)=$P($G(^LAM(X,0)),"^",2)
-        . S ^TMP("C0C-VLAB",$J,1,C0CDA)=""
-        . I C0CDA'=C0CPDA S ^TMP("C0C-VLAB",$J,1,C0CPDA)=""
-        . S ^TMP("C0C-VLAB",$J,2,LRDFN,LRSS,LRIDT,LRSB)=C0CPTEST(64)_"^"_C0CTEST(64)_"^"_C0CLN_"^"_C0CDA_"^"_C0CTEST_"^"_C0CPDA_"^"_C0CPTEST
-        ;
-        S X=$P(LA7X,"^",3)
-        ; If order NLT then update if no order NLT
-        I C0CPTEST(64),$P(X,"!")="" S $P(X,"!")=C0CPTEST(64)
-        ;
-        ; If result NLT then update if no result NLT
-        I C0CTEST(64),$P(X,"!",2)="" S $P(X,"!",2)=C0CTEST(64)
-        ;
-        ; If LOINC found then update variable with LN code
-        I C0CLN'="",$P(X,"!",3)="" S $P(X,"!",3)=C0CLN
-        ;
-        S $P(LA7X,"^",3)=X
-        ;
-        Q
-        ;
-        ;
+ ; Call from LA7QRY2
+ ;
+ N DFN,C0C60,C0C63,C0CACC,C0CDA,C0CDT,C0CLN,C0CPDA,C0CPTEST,C0CSPEC,C0CTEST,X
+ ;
+ S DFN=$P(^LR(LRDFN,0),"^",3)
+ S C0C63(0)=^LR(LRDFN,LRSS,LRIDT,0)
+ S C0CDT=$P(C0C63(0),"^"),C0CACC=$P(C0C63(0),"^",6),C0CSPEC=$P(C0C63(0),"^",5)
+ S (C0CTEST,C0CTEST(64),C0CPTEST,C0CPTEST(64),C0CLN)=""
+ ;
+ ; ^AUPNVLAB("ALR1",5380,"EKT 0307 48",173,3080307.211055,5427197)=""
+ ;
+ S C0C60=""
+ F  S C0C60=$O(^LAB(60,"C",LRSS_";"_LRSB_";1",C0C60)) Q:'C0C60  D  Q:C0CLN'=""
+ . D FINDDT
+ . I C0CDA<1 Q
+ . I $P($G(^AUPNVLAB(C0CDA,11)),"^",8)'=1 Q  ; Source is not LAB DATA file - skip
+ . S C0CLN=$P($G(^AUPNVLAB(C0CDA,11)),"^",13)
+ . S C0CPDA=$P($G(^AUPNVLAB(C0CDA,12)),"^",8)
+ . I C0CPDA="" S C0CPDA=C0CDA
+ . S C0CTEST=$P($G(^AUPNVLAB(C0CDA,0)),"^"),X=$P($G(^LAB(60,C0CTEST,64)),"^",2)
+ . I X S C0CTEST(64)=$P($G(^LAM(X,0)),"^",2)
+ . S C0CPTEST=$P($G(^AUPNVLAB(C0CPDA,0)),"^"),X=$P($G(^LAB(60,C0CPTEST,64)),"^")
+ . I X S C0CPTEST(64)=$P($G(^LAM(X,0)),"^",2)
+ . S ^TMP("C0C-VLAB",$J,1,C0CDA)=""
+ . I C0CDA'=C0CPDA S ^TMP("C0C-VLAB",$J,1,C0CPDA)=""
+ . S ^TMP("C0C-VLAB",$J,2,LRDFN,LRSS,LRIDT,LRSB)=C0CPTEST(64)_"^"_C0CTEST(64)_"^"_C0CLN_"^"_C0CDA_"^"_C0CTEST_"^"_C0CPDA_"^"_C0CPTEST
+ ;
+ S X=$P(LA7X,"^",3)
+ ; If order NLT then update if no order NLT
+ I C0CPTEST(64),$P(X,"!")="" S $P(X,"!")=C0CPTEST(64)
+ ;
+ ; If result NLT then update if no result NLT
+ I C0CTEST(64),$P(X,"!",2)="" S $P(X,"!",2)=C0CTEST(64)
+ ;
+ ; If LOINC found then update variable with LN code
+ I C0CLN'="",$P(X,"!",3)="" S $P(X,"!",3)=C0CLN
+ ;
+ S $P(LA7X,"^",3)=X
+ ;
+ Q
+ ;
+ ;
 TMPCHK  ; Check if LN/NLT codes saved from V LAB file above and use when building OBR/OBX segments
-        ; Called from LA7VOBX1
-        ;
-        N I,X
-        ;
-        S X=$G(^TMP("C0C-VLAB",$J,2,LRDFN,LRSS,LRIDT,LRSB))
-        I X="" Q
-        F I=1:1:3 I $P(LA7X,"!",I)="",$P(X,"^",I)'="" S $P(LA7X,"!",I)=$P(X,"^",I)
-        S $P(LA7VAL,"^",3)=LA7X
-        ;
-        Q
-        ;
-        ;
+ ; Called from LA7VOBX1
+ ;
+ N I,X
+ ;
+ S X=$G(^TMP("C0C-VLAB",$J,2,LRDFN,LRSS,LRIDT,LRSB))
+ I X="" Q
+ F I=1:1:3 I $P(LA7X,"!",I)="",$P(X,"^",I)'="" S $P(LA7X,"!",I)=$P(X,"^",I)
+ S $P(LA7VAL,"^",3)=LA7X
+ ;
+ Q
+ ;
+ ;
 VCHK1   ; Check the entry in V Lab to determine if it meets criteria
-        ;
-        N C0CVLAB,I
-        ;
-        F I=0,12 S C0CVLAB(I)=$G(^AUPNVLAB(C0CDA,I))
-        ;
-        ; JMC 04/13/09 - Store anything for now that meets date criteria.
-        D VSTORE
-        ;
-        Q
-        ;
-        ;
+ ;
+ N C0CVLAB,I
+ ;
+ F I=0,12 S C0CVLAB(I)=$G(^AUPNVLAB(C0CDA,I))
+ ;
+ ; JMC 04/13/09 - Store anything for now that meets date criteria.
+ D VSTORE
+ ;
+ Q
+ ;
+ ;
 VSTORE  ; Store entry for building in HL7 message when parent is from V LAB file.
-        ;
-        N C0CPDA,C0CPTEST
-        ;
-        ; Determine parent test to use for OBR segment
-        S C0CPDA=$P(C0CVLAB(12),"^",8)
-        I C0CPDA="" S C0CPDA=C0CDA
-        ;
-        ; Determine parent test
-        S C0CPTEST=$P($G(^AUPNVLAB(C0CPDA,0)),"^")
-        ;
-        S ^TMP("C0C-VLAB",$J,3,$P(C0CVLAB(0),"^",2),$P(C0CVLAB(12),"^"),C0CPTEST,C0CDA)=C0CPDA
-        ;
-        Q
-        ;
-        ;
+ ;
+ N C0CPDA,C0CPTEST
+ ;
+ ; Determine parent test to use for OBR segment
+ S C0CPDA=$P(C0CVLAB(12),"^",8)
+ I C0CPDA="" S C0CPDA=C0CDA
+ ;
+ ; Determine parent test
+ S C0CPTEST=$P($G(^AUPNVLAB(C0CPDA,0)),"^")
+ ;
+ S ^TMP("C0C-VLAB",$J,3,$P(C0CVLAB(0),"^",2),$P(C0CVLAB(12),"^"),C0CPTEST,C0CDA)=C0CPDA
+ ;
+ Q
+ ;
+ ;
 FINDDT  ; Find entry in V LAB for the date/time or one close to it.
-        ; RPMS stores related specimen entries under the same date/time.
-        ; Lab file #63 creates unique entries with slightly different times.
-        ;
-        S C0CDA=$O(^AUPNVLAB("ALR1",DFN,C0CACC,C0C60,C0CDT,0))
-        I C0CDA>0 Q
-        ;
-        ; If entry found then confirm that specimen type matches.
-        N C0CDTY
-        S C0CDTY=$O(^AUPNVLAB("ALR1",DFN,C0CACC,C0C60,0))
-        I C0CDTY D
-        . I $P(C0CDT,".")'=$P(C0CDTY,".") Q
-        . S C0CDA=$O(^AUPNVLAB("ALR1",DFN,C0CACC,C0C60,C0CDTY,0))
-        . I C0CSPEC'=$P($G(^AUPNVLAB(C0CDA,11)),"^",3) S C0CDA=""
-        ;
-        Q
+ ; RPMS stores related specimen entries under the same date/time.
+ ; Lab file #63 creates unique entries with slightly different times.
+ ;
+ S C0CDA=$O(^AUPNVLAB("ALR1",DFN,C0CACC,C0C60,C0CDT,0))
+ I C0CDA>0 Q
+ ;
+ ; If entry found then confirm that specimen type matches.
+ N C0CDTY
+ S C0CDTY=$O(^AUPNVLAB("ALR1",DFN,C0CACC,C0C60,0))
+ I C0CDTY D
+ . I $P(C0CDT,".")'=$P(C0CDTY,".") Q
+ . S C0CDA=$O(^AUPNVLAB("ALR1",DFN,C0CACC,C0C60,C0CDTY,0))
+ . I C0CSPEC'=$P($G(^AUPNVLAB(C0CDA,11)),"^",3) S C0CDA=""
+ ;
+ Q

ccr/trunk/p/C0CLABS.m

@@ -1 @@
-C0CALABS ; CCDCCR/GPL - CCR/CCD PROCESSING FOR LAB RESULTS ; 10/01/08
- ;;0.3;CCDCCR;nopatch;noreleasedate
+C0CALABS        ; CCDCCR/GPL - CCR/CCD PROCESSING FOR LAB RESULTS ; 10/01/08
+ ;;1.0;C0C;;May 19, 2009;
  ;Copyright 2008,2009 George Lilly, University of Minnesota.
  ;Licensed under the terms of the GNU General Public License.
@@ -19 +19 @@
  ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
            ;
-;MAP(DFN,MOXML,MIVAR,MIXML) ; MAP RESULTS VARIABLES TO XML - GPL -TBD
-MAP(MIXML,DFN,MOXML) ;TO MAKE THIS COMPATIBLE WITH OLD CALLING FOR EXTRACT
+MAP(MIXML,DFN,MOXML)    ;TO MAKE THIS COMPATIBLE WITH OLD CALLING FOR EXTRACT
  ; ASSUMES THAT EXTRACT HAS BEEN RUN AND THE VARIABLES STORED IN MIVAR
  ; MIXML,MIVAR, AND MOXML ARE PASSED BY NAME
@@ -38 +37 @@
  Q
  ;
-RPCMAP(RTN,DFN,RMIVAR,RMIXML) ; RPC ENTRY POINT FOR MAPPING RESULTS
+RPCMAP(RTN,DFN,RMIVAR,RMIXML)   ; RPC ENTRY POINT FOR MAPPING RESULTS
  ; RTN IS PASSED BY REFERENCE
  ;N C0CT0,C0CT,C0CV ; CCR TEMPLATE, RESULTS SUBTEMPLATE, VARIABLES
@@ -115 +114 @@
  Q
  ;
-EXTRACT(ILXML,DFN,OLXML) ; EXTRACT LABS INTO THE C0CLVAR GLOBAL
+EXTRACT(ILXML,DFN,OLXML)        ; EXTRACT LABS INTO THE C0CLVAR GLOBAL
  ;
  ; LABXML AND LABOUTXML ARE PASSED BY NAME SO GLOBALS CAN BE USED
@@ -136 +135 @@
  Q
      ;
-GHL7 ; GET HL7 MESSAGE FOR LABS FOR THIS PATIENT
+GHL7    ; GET HL7 MESSAGE FOR LABS FOR THIS PATIENT
  ; N C0CPTID,C0CSPC,C0CSDT,C0CEDT,C0CR
  ; SET UP FOR LAB API CALL
@@ -156 +155 @@
  Q
  ;
-LIST ; LIST THE HL7 MESSAGE; ALSO, EXTRACT THE RESULT VARIABLES TO C0CLB
+LIST    ; LIST THE HL7 MESSAGE; ALSO, EXTRACT THE RESULT VARIABLES TO C0CLB
  ;
  ; N C0CI,C0CJ,C0COBT,C0CHB,C0CVAR
@@ -230 +229 @@
  ;M ^TMP("C0CRIM","VARS",DFN,"RESULTS")=@C0CLB
  Q
-LTYP(OSEG,OTYP,OVARA,OC0CQT) ;
+LTYP(OSEG,OTYP,OVARA,OC0CQT)    ;
  S OTAB=$NA(@C0CTAB@(OTYP)) ; TABLE FOR SEGMENT TYPE
  I '$D(OC0CQT) S C0CQT=0 ; NOT C0CQT IS DEFAULT
@@ -247 +246 @@
  . . . I OV'="" W OI_": "_$P(@OTAB@(OI),"^",3),": ",OVAR,": ",OV,!
  Q
-LOBX ;
- Q
- ;
-OUT(DFN) ; WRITE OUT A CCR THAT HAS JUST BEEN PROCESSED (FOR TESTING)
+LOBX    ;
+ Q
+ ;
+OUT(DFN)        ; WRITE OUT A CCR THAT HAS JUST BEEN PROCESSED (FOR TESTING)
  N GA,GF,GD
  S GA=$NA(^TMP("C0CCCR",$J,DFN,"CCR",1))
@@ -258 +257 @@
  Q
  ;
-SETTBL ;
+SETTBL  ;
  K X ; CLEAR X
  S X("PID","PID1")="1^00104^Set ID - Patient ID"

ccr/trunk/p/C0CMED.m

@@ -1 +1 @@
 C0CMED  ; WV/CCDCCR/GPL/SMH - CCR/CCD Medications Driver; Mar 23 2009
-        ;;0.6;CCDCCR;;JUL 16,2008;
-        ; Copyright 2008,2009 George Lilly, University of Minnesota and Sam Habiel.
-        ; 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.
-        ;
-        ; --Revision History
-        ; July 2008 - Initial Version/GPL
-        ; July 2008 - March 2009 various revisions
-        ; March 2009 - Reconstruction of routine as driver for other med routines/SMH
-        ;
-        Q
+ ;;1.0;C0C;;May 19, 2009;
+ ; Copyright 2008,2009 George Lilly, University of Minnesota and Sam Habiel.
+ ; 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.
+ ;
+ ; --Revision History
+ ; July 2008 - Initial Version/GPL
+ ; July 2008 - March 2009 various revisions
+ ; March 2009 - Reconstruction of routine as driver for other med routines/SMH
+ ;
+ Q
 EXTRACT(MEDXML,DFN,MEDOUTXML)   ; Private; Extract medications into provided XML template
-        ; DFN passed by reference
-        ; MEDXML and MEDOUTXML are passed by Name
-        ; MEDXML is the input template
-        ; MEDOUTXML is the output template
-        ; Both of them refer to ^TMP globals where the XML documents are stored
-        ; 
-        ; -- This ep is the driver for extracting medications into the provided XML template
-        ; 1. VA Outpatient Meds are in C0CMED1
-        ; 2. VA Pending Meds are in C0CMED2
-        ; 3. VA non-VA Meds are in C0CMED3
-        ; 4. VA Inpatient IV Meds are in C0CMED4 (not functional)
-        ; 5. VA Inpatient UD Meds are in C0CMED5 (doesn't exist yet)--March 2009
-        ; 6. RPMS Meds are in C0CMED6. Need to create other routines for subdivisions of RPMS Meds is not known at this time.
-        ;
-        ; --Get parameters for meds
-        S @MEDOUTXML@(0)=0 ; By default, empty.
-        N C0CMFLAG
-        S C0CMFLAG=$$GET^C0CPARMS("MEDALL")_"^"_$$GET^C0CPARMS("MEDLIMIT")_"^"_$$GET^C0CPARMS("MEDACTIVE")_"^"_$$GET^C0CPARMS("MEDPENDING")
-        W:$G(DEBUG) "Med Parameters: ",!
-        W:$G(DEBUG) "ALL: ",+C0CMFLAG,!
-        W:$G(DEBUG) "LIMIT: ",$P(C0CMFLAG,U,2),!
-        W:$G(DEBUG) "ACTIVE: ",$P(C0CMFLAG,U,3),!
-        W:$G(DEBUG) "PEND: ",$P(C0CMFLAG,U,4),!
-        ; --Find out what system we are on and branch out...
-        W:$G(DEBUG) "Agenecy: ",$G(DUZ("AG"))
-        I $$RPMS^C0CUTIL() D RPMS QUIT
-        I ($$VISTA^C0CUTIL())!($$WV^C0CUTIL())!($$OV^C0CUTIL()) D VISTA QUIT
+ ; DFN passed by reference
+ ; MEDXML and MEDOUTXML are passed by Name
+ ; MEDXML is the input template
+ ; MEDOUTXML is the output template
+ ; Both of them refer to ^TMP globals where the XML documents are stored
+ ; 
+ ; -- This ep is the driver for extracting medications into the provided XML template
+ ; 1. VA Outpatient Meds are in C0CMED1
+ ; 2. VA Pending Meds are in C0CMED2
+ ; 3. VA non-VA Meds are in C0CMED3
+ ; 4. VA Inpatient IV Meds are in C0CMED4 (not functional)
+ ; 5. VA Inpatient UD Meds are in C0CMED5 (doesn't exist yet)--March 2009
+ ; 6. RPMS Meds are in C0CMED6. Need to create other routines for subdivisions of RPMS Meds is not known at this time.
+ ;
+ ; --Get parameters for meds
+ S @MEDOUTXML@(0)=0 ; By default, empty.
+ N C0CMFLAG
+ S C0CMFLAG=$$GET^C0CPARMS("MEDALL")_"^"_$$GET^C0CPARMS("MEDLIMIT")_"^"_$$GET^C0CPARMS("MEDACTIVE")_"^"_$$GET^C0CPARMS("MEDPENDING")
+ W:$G(DEBUG) "Med Parameters: ",!
+ W:$G(DEBUG) "ALL: ",+C0CMFLAG,!
+ W:$G(DEBUG) "LIMIT: ",$P(C0CMFLAG,U,2),!
+ W:$G(DEBUG) "ACTIVE: ",$P(C0CMFLAG,U,3),!
+ W:$G(DEBUG) "PEND: ",$P(C0CMFLAG,U,4),!
+ ; --Find out what system we are on and branch out...
+ W:$G(DEBUG) "Agenecy: ",$G(DUZ("AG"))
+ I $$RPMS^C0CUTIL() D RPMS QUIT
+ I ($$VISTA^C0CUTIL())!($$WV^C0CUTIL())!($$OV^C0CUTIL()) D VISTA QUIT
 RPMS    
-        D EXTRACT^C0CMED6(MEDXML,DFN,MEDOUTXML,C0CMFLAG) QUIT
+ D EXTRACT^C0CMED6(MEDXML,DFN,MEDOUTXML,C0CMFLAG) QUIT
 VISTA   
-        N MEDCOUNT S MEDCOUNT=0
-        K ^TMP($J,"MED")
-        N HIST S HIST=$NA(^TMP($J,"MED","HIST")) ; Meds already dispensed
-        N PEND S PEND=$NA(^TMP($J,"MED","PEND")) ; Pending Meds
-        N NVA S NVA=$NA(^TMP($J,"MED","NVA")) ; non-VA Meds
-        S @HIST@(0)=0,@PEND@(0)=0,@NVA@(0)=0 ; At first, they are all empty... (prevent undefined errors)
-        ; N IPIV ; Inpatient IV Meds
-        ; N IPUD ; Inpatient UD Meds
-        D EXTRACT^C0CMED1(MEDXML,DFN,HIST,.MEDCOUNT,C0CMFLAG) ; Historical OP Meds
-        D:$P(C0CMFLAG,U,4) EXTRACT^C0CMED2(MEDXML,DFN,PEND,.MEDCOUNT) ; Pending Meds
-        D:+C0CMFLAG EXTRACT^C0CMED3(MEDXML,DFN,NVA,.MEDCOUNT) ; non-VA Meds 
-        I @HIST@(0)>0 D  
-        . D CP^C0CXPATH(HIST,MEDOUTXML)
-        . W:$G(DEBUG) "HAS ACTIVE OP MEDS",!
-        I @PEND@(0)>0 D  
-        . I @HIST@(0)>0 D INSINNER^C0CXPATH(MEDOUTXML,PEND) ;Add Pending to Historical
-        . E  D CP^C0CXPATH(PEND,MEDOUTXML) ; No historical, just copy
-        . W:$G(DEBUG) "HAS OP PENDING MEDS",!
-        I @NVA@(0)>0 D 
-        . I @HIST@(0)>0!(@PEND@(0)>0) D INSINNER^C0CXPATH(MEDOUTXML,NVA) 
-        . E  D CP^C0CXPATH(NVA,MEDOUTXML) 
-        . W:$G(DEBUG) "HAS NON-VA MEDS",!
-        Q
-        
+ N MEDCOUNT S MEDCOUNT=0
+ K ^TMP($J,"MED")
+ N HIST S HIST=$NA(^TMP($J,"MED","HIST")) ; Meds already dispensed
+ N PEND S PEND=$NA(^TMP($J,"MED","PEND")) ; Pending Meds
+ N NVA S NVA=$NA(^TMP($J,"MED","NVA")) ; non-VA Meds
+ S @HIST@(0)=0,@PEND@(0)=0,@NVA@(0)=0 ; At first, they are all empty... (prevent undefined errors)
+ ; N IPIV ; Inpatient IV Meds
+ ; N IPUD ; Inpatient UD Meds
+ D EXTRACT^C0CMED1(MEDXML,DFN,HIST,.MEDCOUNT,C0CMFLAG) ; Historical OP Meds
+ D:$P(C0CMFLAG,U,4) EXTRACT^C0CMED2(MEDXML,DFN,PEND,.MEDCOUNT) ; Pending Meds
+ D:+C0CMFLAG EXTRACT^C0CMED3(MEDXML,DFN,NVA,.MEDCOUNT) ; non-VA Meds 
+ I @HIST@(0)>0 D  
+ . D CP^C0CXPATH(HIST,MEDOUTXML)
+ . W:$G(DEBUG) "HAS ACTIVE OP MEDS",!
+ I @PEND@(0)>0 D  
+ . I @HIST@(0)>0 D INSINNER^C0CXPATH(MEDOUTXML,PEND) ;Add Pending to Historical
+ . E  D CP^C0CXPATH(PEND,MEDOUTXML) ; No historical, just copy
+ . W:$G(DEBUG) "HAS OP PENDING MEDS",!
+ I @NVA@(0)>0 D 
+ . I @HIST@(0)>0!(@PEND@(0)>0) D INSINNER^C0CXPATH(MEDOUTXML,NVA) 
+ . E  D CP^C0CXPATH(NVA,MEDOUTXML) 
+ . W:$G(DEBUG) "HAS NON-VA MEDS",!
+ Q
+ 

ccr/trunk/p/C0CMED1.m

@@ -1 +1 @@
 C0CMED1 ; WV/CCDCCR/SMH - CCR/CCD PROCESSING FOR MEDICATIONS ;01/10/09
-        ;;0.1;CCDCCR;;JUL 16,2008;
-        ;;Last modified Sat Jan 10 21:42:27 PST 2009
-        ; Copyright 2009 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
-        ;
+ ;;1.0;C0C;;May 19, 2009;
+ ;;Last modified Sat Jan 10 21:42:27 PST 2009
+ ; Copyright 2009 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(MINXML,DFN,OUTXML,MEDCOUNT,FLAGS)       ; EXTRACT MEDICATIONS INTO PROVIDED XML TEMPLATE
-        ;
-        ; INXML AND OUTXML ARE PASSED BY NAME SO GLOBALS CAN BE USED
-        ; INXML WILL CONTAIN ONLY THE MEDICATIONS SECTION OF THE OVERALL TEMPLATE
-        ;
-        ; MEDS is return array from RPC.
-        ; MAP is a mapping variable map (store result) for each med
-        ; MED is holds each array element from MEDS(J), one medicine
-        ; MEDCOUNT is a counter passed by Reference.
-        ; FLAGS are: MEDALL(bool)^MEDLIMIT(int)^MEDACTIVE(bool)^MEDPENDING(bool)
-        ; FLAGS are set-up in C0CMED.
-        ;
-        ; RX^PSO52API is a Pharmacy Re-Enginnering (PRE) API to get all
-        ; med data available.
-        ; http://www.va.gov/vdl/documents/Clinical/Pharm-Outpatient_Pharmacy/phar_1_api_r0807.pdf
-        ; Output of API is ^TMP($J,"SUBSCRIPT",DFN,RXIENS).
-        ; D PARY^C0CXPATH(MINXML)
-        N MEDS,MAP
-        K ^TMP($J,"CCDCCR") ; PLEASE DON'T KILL ALL OF ^TMP($J) HERE!!!!
-        N ALL S ALL=+FLAGS
-        N ACTIVE S ACTIVE=$P(FLAGS,U,3)
-        ; Below, X1 is today; X2 is the number of days we want to go back
-        ; X is the result of this calculation using C^%DTC.
-        N X,X1,X2
-        S X1=DT
-        S X2=-$P($P(FLAGS,U,2),"-",2)
-        D C^%DTC
-        ; I discovered that I shouldn't put an ending date (last parameter)
-        ; because it seems that it will get meds whose beginning is after X but
-        ; whose exipriation is before the ending date.
-        D RX^PSO52API(DFN,"CCDCCR","","","",X,"")
-        M MEDS=^TMP($J,"CCDCCR",DFN)
-        ; @(0) contains the number of meds or -1^NO DATA FOUND
-        ; If it is -1, we quit.
-        I $P(MEDS(0),U)=-1 S @OUTXML@(0)=0 QUIT
-        ZWRITE:$G(DEBUG) MEDS
-        N RXIEN S RXIEN=0
-        F  S RXIEN=$O(MEDS(RXIEN)) Q:RXIEN=""  D  ; FOR EACH MEDICATION IN THE LIST
-        . N MED M MED=MEDS(RXIEN)
-        . I 'ALL,ACTIVE,$P(MED(100),U,2)'="ACTIVE" QUIT
-        . S MEDCOUNT=MEDCOUNT+1
-        . W:$G(DEBUG) "RXIEN IS ",RXIEN,!
-        . S MAP=$NA(^TMP("C0CCCR",$J,"MEDMAP",MEDCOUNT))
-        . ; K @MAP DO NOT KILL HERE, WAS CLEARED IN C0CMED
-        . W:$G(DEBUG) "MAP= ",MAP,!
-        . S @MAP@("MEDOBJECTID")="MED"_MEDCOUNT ; MEDCOUNT FOR ID
-        . ; S @MAP@("MEDOBJECTID")="MED"_MED(.01) ;Rx Number
-        . S @MAP@("MEDISSUEDATETXT")="Issue Date"
-        . S @MAP@("MEDISSUEDATE")=$$FMDTOUTC^C0CUTIL($P(MED(1),U))
-        . S @MAP@("MEDLASTFILLDATETXT")="Last Fill Date"
-        . S @MAP@("MEDLASTFILLDATE")=$$FMDTOUTC^C0CUTIL($P(MED(101),U))
-        . S @MAP@("MEDRXNOTXT")="Prescription Number"
-        . S @MAP@("MEDRXNO")=MED(.01)
-        . S @MAP@("MEDTYPETEXT")="Medication"
-        . S @MAP@("MEDDETAILUNADORNED")=""  ; Leave blank, field has its uses
-        . S @MAP@("MEDSTATUSTEXT")=$P(MED(100),U,2)
-        . S @MAP@("MEDSOURCEACTORID")="ACTORPROVIDER_"_$P(MED(4),U)
-        . S @MAP@("MEDPRODUCTNAMETEXT")=$P(MED(6),U,2)
-        . ; 12/30/08: I will be using RxNorm for coding...
-        . ; 176.001 is the file for Concepts; 176.003 is the file for
-        . ; sources (i.e. for RxNorm Version)
-        . ;
-        . ; We need the VUID first for the National Drug File entry first
-        . ; We get the VUID of the drug, by looking up the VA Product entry
-        . ; (file 50.68) using the call NDF^PSS50, returned in node 22.
-        . ; Field 99.99 is the VUID.
-        . ;
-        . ; We use the VUID to look up the RxNorm in file 176.001; same idea.
-        . ; Get IEN first using $$FIND1^DIC, then get the RxNorm number by
-        . ; $$GET1^DIQ.
-        . ;
-        . ; I get the RxNorm name and version from the RxNorm Sources (file
-        . ; 176.003), by searching for "RXNORM", then get the data.
-        . N MEDIEN S MEDIEN=$P(MED(6),U)
-        . D NDF^PSS50(MEDIEN,,,,,"NDF")
-        . N NDFDATA M NDFDATA=^TMP($J,"NDF",MEDIEN)
-        . N NDFIEN S NDFIEN=$P(NDFDATA(20),U)
-        . N VAPROD S VAPROD=$P(NDFDATA(22),U)
-        . ;
-        . ; NDFIEN is not necessarily defined; it won't be if the drug
-        . ; is not matched to the national drug file (e.g. if the drug is
-        . ; new on the market, compounded, or is a fake drug [blue pill].
-        . ; To protect against failure, I will put an if/else block
-        . ;
-        . N VUID,RXNIEN,RXNORM,SRCIEN,RXNNAME,RXNVER
-        . I NDFIEN,$D(^C0CRXN) D  ; $Data is for Systems that don't have our RxNorm file yet.
-        . . S VUID=$$GET1^DIQ(50.68,VAPROD,99.99)
-        . . S RXNIEN=$$FIND1^DIC(176.001,,,VUID,"VUID")
-        . . S RXNORM=$$GET1^DIQ(176.001,RXNIEN,.01)
-        . . S SRCIEN=$$FIND1^DIC(176.003,,"B","RXNORM")
-        . . S RXNNAME=$$GET1^DIQ(176.003,SRCIEN,6)
-        . . S RXNVER=$$GET1^DIQ(176.003,SRCIEN,7)
-        . ;
-        . E  S (RXNORM,RXNNAME,RXNVER)=""
-        . ; End if/else block
-        . S @MAP@("MEDPRODUCTNAMECODEVALUE")=RXNORM
-        . S @MAP@("MEDPRODUCTNAMECODINGINGSYSTEM")=RXNNAME
-        . S @MAP@("MEDPRODUCTNAMECODEVERSION")=RXNVER
-        . ;
-        . S @MAP@("MEDBRANDNAMETEXT")=MED(6.5)
-        . D DOSE^PSS50(MEDIEN,,,,,"DOSE")
-        . N DOSEDATA M DOSEDATA=^TMP($J,"DOSE",MEDIEN)
-        . S @MAP@("MEDSTRENGTHVALUE")=DOSEDATA(901)
-        . S @MAP@("MEDSTRENGTHUNIT")=$P(DOSEDATA(902),U,2)
-        . ; Units, concentration, etc, come from another call
-        . ; $$CPRS^PSNAPIS which returns dosage-form^va class^strengh^unit
-        . ; This call takes nodes 1 and 3 of ^PSDRUG(D0,"ND") as parameters
-        . ; NDF Entry IEN, and VA Product IEN
-        . ; These can be obtained using NDF^PSS50 (IEN,,,,,"SUBSCRIPT")
-        . ; These have been collected above.
-        . N CONCDATA
-        . ; If a drug was not matched to NDF, then the NDFIEN is gonna be ""
-        . ; and this will crash the call. So...
-        . I NDFIEN="" S CONCDATA=""
-        . E  S CONCDATA=$$CPRS^PSNAPIS(NDFIEN,VAPROD)
-        . S @MAP@("MEDFORMTEXT")=$P(CONCDATA,U,1)
-        . S @MAP@("MEDCONCVALUE")=$P(CONCDATA,U,3)
-        . S @MAP@("MEDCONCUNIT")=$P(CONCDATA,U,4)
-        . S @MAP@("MEDQUANTITYVALUE")=MED(7)
-        . ; Oddly, there is no easy place to find the dispense unit.
-        . ; It's not included in the original call, so we have to go to the drug file.
-        . ; That would be DATA^PSS50(IEN,,,,,"SUBSCRIPT")
-        . ; Node 14.5 is the Dispense Unit
-        . D DATA^PSS50(MEDIEN,,,,,"QTY")
-        . N QTYDATA M QTYDATA=^TMP($J,"QTY",MEDIEN)
-        . S @MAP@("MEDQUANTITYUNIT")=QTYDATA(14.5)
-        . ;
-        . ; --- START OF DIRECTIONS ---
-        . ; Sig data not in any API :-(  Oh yes, you can get the whole thing, but...
-        . ; we want the compoenents.
-        . ; It's in node 6 of ^PSRX(IEN)
-        . ; So, here we go again
-        . ; ^PSRX(D0,6,D1,0)= (#.01) DOSAGE ORDERED [1F] ^ (#1) DISPENSE UNITS PER DOSE
-        . ; ==>[2N] ^ (#2) UNITS [3P:50.607] ^ (#3) NOUN [4F] ^ (#4)
-        . ; ==>DURATION [5F] ^ (#5) CONJUNCTION [6S] ^ (#6) ROUTE
-        . ; ==>[7P:51.2] ^ (#7) SCHEDULE [8F] ^ (#8) VERB [9F] ^
-        . ;
-        . N DIRNUM S DIRNUM=0 ; Sigline number
-        . S DIRCNT=0 ; COUNT OF MULTIPLE DIRECTIONS
-        . F  S DIRNUM=$O(^PSRX(RXIEN,6,DIRNUM)) Q:DIRNUM=""  D
-        . . S DIRCNT=DIRCNT+1 ; INCREMENT DIRECTIONS COUNT
-        . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDIRECTIONDESCRIPTIONTEXT")=""  ; This is reserved for systems not able to generate the sig in components.
-        . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDOSEINDICATOR")="1"  ; means that we are specifying it. See E2369-05.
-        . . N SIGDATA S SIGDATA=^PSRX(RXIEN,6,DIRNUM,0)
-        . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDELIVERYMETHOD")=$P(SIGDATA,U,9)
-        . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDOSEVALUE")=$P(SIGDATA,U,1)
-        . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDOSEUNIT")=@MAP@("MEDCONCUNIT")
-        . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDRATEVALUE")=""  ; For inpatient
-        . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDRATEUNIT")=""  ; For inpatient
-        . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDVEHICLETEXT")=""  ; For inpatient
-        . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDIRECTIONROUTETEXT")=$$GET1^DIQ(51.2,$P(SIGDATA,U,7),.01)
-        . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDFREQUENCYVALUE")=$P(SIGDATA,U,8)
-        . . ; Invervals... again another call.
-        . . ; In the wisdom of the original programmers, the schedule is a free text field
-        . . ; However, it gets translated by a call to the administration schedule file
-        . . ; to see if that schedule exists.
-        . . ; That's the same thing I am going to do.
-        . . ; The call is AP^PSS51P1(PSSPP,PSSFT,PSSWDIEN,PSSSTPY,LIST,PSSFREQ).
-        . . ; PSSPP is "PSJ" (for some reason, schedules are stored as PSJ, not PSO--
-        . . ; I looked), PSSFT is the name, and list is the ^TMP name to store the data in.
-        . . ; So...
-        . . D AP^PSS51P1("PSJ",$P(SIGDATA,U,8),,,"SCHEDULE")
-        . . N SCHEDATA M SCHEDATA=^TMP($J,"SCHEDULE")
-        . . N INTERVAL
-        . . I $P(SCHEDATA(0),U)=-1 S INTERVAL=""
-        . . E  D
-        . . . N SUB S SUB=$O(SCHEDATA(0))
-        . . . S INTERVAL=SCHEDATA(SUB,2)
-        . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDINTERVALVALUE")=INTERVAL
-        . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDINTERVALUNIT")="Minute"
-        . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDURATIONVALUE")=$P(SIGDATA,U,5)
-        . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDURATIONUNIT")=""
-        . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPRNFLAG")=$P(SIGDATA,U,8)["PRN"
-        . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMOBJECTID")=""
-        . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMTYPETXT")=""
-        . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMDESCRIPTION")=""
-        . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMCODEVALUE")=""
-        . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMCODINGSYSTEM")=""
-        . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMCODINGVERSION")=""
-        . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMSOURCEACTORID")=""
-        . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDSTOPINDICATOR")=""
-        . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDIRSEQ")=DIRNUM
-        . . N DIRMOD S DIRMOD=$P(SIGDATA,U,6)
-        . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDMULDIRMOD")=$S(DIRMOD="T":"THEN",DIRMOD="A":"AND",DIRMOD="X":"EXCEPT",1:"")
-        . ;
-        . ; --- END OF DIRECTIONS ---
-        . ;
-        . ; ^PSRX(22,"INS1",1,0)="FOR BLOOD PRESSURE"
-        . S @MAP@("MEDPTINSTRUCTIONS")=$G(^PSRX(RXIEN,"INS1",1,0))
-        . ; ^PSRX(22,"PRC",1,0)="Pharmacist: you must obey my command"
-        . S @MAP@("MEDFULLFILLMENTINSTRUCTIONS")=$G(^PSRX(RXIEN,"PRC",1,0))
-        . S @MAP@("MEDRFNO")=MED(9)
-        . N RESULT S RESULT=$NA(^TMP("C0CCCR",$J,"MAPPED"))
-        . K @RESULT
-        . D MAP^C0CXPATH(MINXML,MAP,RESULT)
-        . ; MAPPING DIRECTIONS
-        . N DIRXML1 S DIRXML1="MEDDIR1" ; VARIABLE AND NAME VARIABLE TEMPLATE
-        . N DIRXML2 S DIRXML2="MEDDIR2" ; VARIABLE AND NAME VARIABLE RESULT
-        . D QUERY^C0CXPATH(MINXML,"//Medications/Medication/Directions",DIRXML1)
-        . D REPLACE^C0CXPATH(RESULT,"","//Medications/Medication/Directions")
-        . ; N MDZ1,MDZNA
-        . I DIRCNT>0 D  ; IF THERE ARE DIRCTIONS
-        . . F MDZ1=1:1:DIRCNT  D  ; FOR EACH DIRECTION
-        . . . S MDZNA=$NA(@MAP@("M","DIRECTIONS",MDZ1))
-        . . . D MAP^C0CXPATH(DIRXML1,MDZNA,DIRXML2)
-        . . . D INSERT^C0CXPATH(RESULT,DIRXML2,"//Medications/Medication")
-        . I MEDCOUNT=1 D CP^C0CXPATH(RESULT,OUTXML) ; First one is a copy
-        . E  D INSINNER^C0CXPATH(OUTXML,RESULT) ; AFTER FIRST, INSERT INNER XML
-        N MEDTMP,MEDI
-        D MISSING^C0CXPATH(OUTXML,"MEDTMP") ; SEARCH XML FOR MISSING VARS
-        I MEDTMP(0)>0 D  ; IF THERE ARE MISSING VARS - MARKED AS @@X@@
-        . W "MEDICATION MISSING ",!
-        . F MEDI=1:1:MEDTMP(0) W MEDTMP(MEDI),!
-        Q
-        ;
+ ;
+ ; INXML AND OUTXML ARE PASSED BY NAME SO GLOBALS CAN BE USED
+ ; INXML WILL CONTAIN ONLY THE MEDICATIONS SECTION OF THE OVERALL TEMPLATE
+ ;
+ ; MEDS is return array from RPC.
+ ; MAP is a mapping variable map (store result) for each med
+ ; MED is holds each array element from MEDS(J), one medicine
+ ; MEDCOUNT is a counter passed by Reference.
+ ; FLAGS are: MEDALL(bool)^MEDLIMIT(int)^MEDACTIVE(bool)^MEDPENDING(bool)
+ ; FLAGS are set-up in C0CMED.
+ ;
+ ; RX^PSO52API is a Pharmacy Re-Enginnering (PRE) API to get all
+ ; med data available.
+ ; http://www.va.gov/vdl/documents/Clinical/Pharm-Outpatient_Pharmacy/phar_1_api_r0807.pdf
+ ; Output of API is ^TMP($J,"SUBSCRIPT",DFN,RXIENS).
+ ; D PARY^C0CXPATH(MINXML)
+ N MEDS,MAP
+ K ^TMP($J,"CCDCCR") ; PLEASE DON'T KILL ALL OF ^TMP($J) HERE!!!!
+ N ALL S ALL=+FLAGS
+ N ACTIVE S ACTIVE=$P(FLAGS,U,3)
+ ; Below, X1 is today; X2 is the number of days we want to go back
+ ; X is the result of this calculation using C^%DTC.
+ N X,X1,X2
+ S X1=DT
+ S X2=-$P($P(FLAGS,U,2),"-",2)
+ D C^%DTC
+ ; I discovered that I shouldn't put an ending date (last parameter)
+ ; because it seems that it will get meds whose beginning is after X but
+ ; whose exipriation is before the ending date.
+ D RX^PSO52API(DFN,"CCDCCR","","","",X,"")
+ M MEDS=^TMP($J,"CCDCCR",DFN)
+ ; @(0) contains the number of meds or -1^NO DATA FOUND
+ ; If it is -1, we quit.
+ I $P(MEDS(0),U)=-1 S @OUTXML@(0)=0 QUIT
+ ZWRITE:$G(DEBUG) MEDS
+ N RXIEN S RXIEN=0
+ F  S RXIEN=$O(MEDS(RXIEN)) Q:RXIEN=""  D  ; FOR EACH MEDICATION IN THE LIST
+ . N MED M MED=MEDS(RXIEN)
+ . I 'ALL,ACTIVE,$P(MED(100),U,2)'="ACTIVE" QUIT
+ . S MEDCOUNT=MEDCOUNT+1
+ . W:$G(DEBUG) "RXIEN IS ",RXIEN,!
+ . S MAP=$NA(^TMP("C0CCCR",$J,"MEDMAP",MEDCOUNT))
+ . ; K @MAP DO NOT KILL HERE, WAS CLEARED IN C0CMED
+ . W:$G(DEBUG) "MAP= ",MAP,!
+ . S @MAP@("MEDOBJECTID")="MED"_MEDCOUNT ; MEDCOUNT FOR ID
+ . ; S @MAP@("MEDOBJECTID")="MED"_MED(.01) ;Rx Number
+ . S @MAP@("MEDISSUEDATETXT")="Issue Date"
+ . S @MAP@("MEDISSUEDATE")=$$FMDTOUTC^C0CUTIL($P(MED(1),U))
+ . S @MAP@("MEDLASTFILLDATETXT")="Last Fill Date"
+ . S @MAP@("MEDLASTFILLDATE")=$$FMDTOUTC^C0CUTIL($P(MED(101),U))
+ . S @MAP@("MEDRXNOTXT")="Prescription Number"
+ . S @MAP@("MEDRXNO")=MED(.01)
+ . S @MAP@("MEDTYPETEXT")="Medication"
+ . S @MAP@("MEDDETAILUNADORNED")=""  ; Leave blank, field has its uses
+ . S @MAP@("MEDSTATUSTEXT")=$P(MED(100),U,2)
+ . S @MAP@("MEDSOURCEACTORID")="ACTORPROVIDER_"_$P(MED(4),U)
+ . S @MAP@("MEDPRODUCTNAMETEXT")=$P(MED(6),U,2)
+ . ; 12/30/08: I will be using RxNorm for coding...
+ . ; 176.001 is the file for Concepts; 176.003 is the file for
+ . ; sources (i.e. for RxNorm Version)
+ . ;
+ . ; We need the VUID first for the National Drug File entry first
+ . ; We get the VUID of the drug, by looking up the VA Product entry
+ . ; (file 50.68) using the call NDF^PSS50, returned in node 22.
+ . ; Field 99.99 is the VUID.
+ . ;
+ . ; We use the VUID to look up the RxNorm in file 176.001; same idea.
+ . ; Get IEN first using $$FIND1^DIC, then get the RxNorm number by
+ . ; $$GET1^DIQ.
+ . ;
+ . ; I get the RxNorm name and version from the RxNorm Sources (file
+ . ; 176.003), by searching for "RXNORM", then get the data.
+ . N MEDIEN S MEDIEN=$P(MED(6),U)
+ . D NDF^PSS50(MEDIEN,,,,,"NDF")
+ . N NDFDATA M NDFDATA=^TMP($J,"NDF",MEDIEN)
+ . N NDFIEN S NDFIEN=$P(NDFDATA(20),U)
+ . N VAPROD S VAPROD=$P(NDFDATA(22),U)
+ . ;
+ . ; NDFIEN is not necessarily defined; it won't be if the drug
+ . ; is not matched to the national drug file (e.g. if the drug is
+ . ; new on the market, compounded, or is a fake drug [blue pill].
+ . ; To protect against failure, I will put an if/else block
+ . ;
+ . N VUID,RXNIEN,RXNORM,SRCIEN,RXNNAME,RXNVER
+ . I NDFIEN,$D(^C0CRXN) D  ; $Data is for Systems that don't have our RxNorm file yet.
+ . . S VUID=$$GET1^DIQ(50.68,VAPROD,99.99)
+ . . S RXNIEN=$$FIND1^DIC(176.001,,,VUID,"VUID")
+ . . S RXNORM=$$GET1^DIQ(176.001,RXNIEN,.01)
+ . . S SRCIEN=$$FIND1^DIC(176.003,,"B","RXNORM")
+ . . S RXNNAME=$$GET1^DIQ(176.003,SRCIEN,6)
+ . . S RXNVER=$$GET1^DIQ(176.003,SRCIEN,7)
+ . ;
+ . E  S (RXNORM,RXNNAME,RXNVER)=""
+ . ; End if/else block
+ . S @MAP@("MEDPRODUCTNAMECODEVALUE")=RXNORM
+ . S @MAP@("MEDPRODUCTNAMECODINGINGSYSTEM")=RXNNAME
+ . S @MAP@("MEDPRODUCTNAMECODEVERSION")=RXNVER
+ . ;
+ . S @MAP@("MEDBRANDNAMETEXT")=MED(6.5)
+ . D DOSE^PSS50(MEDIEN,,,,,"DOSE")
+ . N DOSEDATA M DOSEDATA=^TMP($J,"DOSE",MEDIEN)
+ . S @MAP@("MEDSTRENGTHVALUE")=DOSEDATA(901)
+ . S @MAP@("MEDSTRENGTHUNIT")=$P(DOSEDATA(902),U,2)
+ . ; Units, concentration, etc, come from another call
+ . ; $$CPRS^PSNAPIS which returns dosage-form^va class^strengh^unit
+ . ; This call takes nodes 1 and 3 of ^PSDRUG(D0,"ND") as parameters
+ . ; NDF Entry IEN, and VA Product IEN
+ . ; These can be obtained using NDF^PSS50 (IEN,,,,,"SUBSCRIPT")
+ . ; These have been collected above.
+ . N CONCDATA
+ . ; If a drug was not matched to NDF, then the NDFIEN is gonna be ""
+ . ; and this will crash the call. So...
+ . I NDFIEN="" S CONCDATA=""
+ . E  S CONCDATA=$$CPRS^PSNAPIS(NDFIEN,VAPROD)
+ . S @MAP@("MEDFORMTEXT")=$P(CONCDATA,U,1)
+ . S @MAP@("MEDCONCVALUE")=$P(CONCDATA,U,3)
+ . S @MAP@("MEDCONCUNIT")=$P(CONCDATA,U,4)
+ . S @MAP@("MEDQUANTITYVALUE")=MED(7)
+ . ; Oddly, there is no easy place to find the dispense unit.
+ . ; It's not included in the original call, so we have to go to the drug file.
+ . ; That would be DATA^PSS50(IEN,,,,,"SUBSCRIPT")
+ . ; Node 14.5 is the Dispense Unit
+ . D DATA^PSS50(MEDIEN,,,,,"QTY")
+ . N QTYDATA M QTYDATA=^TMP($J,"QTY",MEDIEN)
+ . S @MAP@("MEDQUANTITYUNIT")=QTYDATA(14.5)
+ . ;
+ . ; --- START OF DIRECTIONS ---
+ . ; Sig data not in any API :-(  Oh yes, you can get the whole thing, but...
+ . ; we want the compoenents.
+ . ; It's in node 6 of ^PSRX(IEN)
+ . ; So, here we go again
+ . ; ^PSRX(D0,6,D1,0)= (#.01) DOSAGE ORDERED [1F] ^ (#1) DISPENSE UNITS PER DOSE
+ . ; ==>[2N] ^ (#2) UNITS [3P:50.607] ^ (#3) NOUN [4F] ^ (#4)
+ . ; ==>DURATION [5F] ^ (#5) CONJUNCTION [6S] ^ (#6) ROUTE
+ . ; ==>[7P:51.2] ^ (#7) SCHEDULE [8F] ^ (#8) VERB [9F] ^
+ . ;
+ . N DIRNUM S DIRNUM=0 ; Sigline number
+ . S DIRCNT=0 ; COUNT OF MULTIPLE DIRECTIONS
+ . F  S DIRNUM=$O(^PSRX(RXIEN,6,DIRNUM)) Q:DIRNUM=""  D
+ . . S DIRCNT=DIRCNT+1 ; INCREMENT DIRECTIONS COUNT
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDIRECTIONDESCRIPTIONTEXT")=""  ; This is reserved for systems not able to generate the sig in components.
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDOSEINDICATOR")="1"  ; means that we are specifying it. See E2369-05.
+ . . N SIGDATA S SIGDATA=^PSRX(RXIEN,6,DIRNUM,0)
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDELIVERYMETHOD")=$P(SIGDATA,U,9)
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDOSEVALUE")=$P(SIGDATA,U,1)
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDOSEUNIT")=@MAP@("MEDCONCUNIT")
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDRATEVALUE")=""  ; For inpatient
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDRATEUNIT")=""  ; For inpatient
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDVEHICLETEXT")=""  ; For inpatient
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDIRECTIONROUTETEXT")=$$GET1^DIQ(51.2,$P(SIGDATA,U,7),.01)
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDFREQUENCYVALUE")=$P(SIGDATA,U,8)
+ . . ; Invervals... again another call.
+ . . ; In the wisdom of the original programmers, the schedule is a free text field
+ . . ; However, it gets translated by a call to the administration schedule file
+ . . ; to see if that schedule exists.
+ . . ; That's the same thing I am going to do.
+ . . ; The call is AP^PSS51P1(PSSPP,PSSFT,PSSWDIEN,PSSSTPY,LIST,PSSFREQ).
+ . . ; PSSPP is "PSJ" (for some reason, schedules are stored as PSJ, not PSO--
+ . . ; I looked), PSSFT is the name, and list is the ^TMP name to store the data in.
+ . . ; So...
+ . . D AP^PSS51P1("PSJ",$P(SIGDATA,U,8),,,"SCHEDULE")
+ . . N SCHEDATA M SCHEDATA=^TMP($J,"SCHEDULE")
+ . . N INTERVAL
+ . . I $P(SCHEDATA(0),U)=-1 S INTERVAL=""
+ . . E  D
+ . . . N SUB S SUB=$O(SCHEDATA(0))
+ . . . S INTERVAL=SCHEDATA(SUB,2)
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDINTERVALVALUE")=INTERVAL
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDINTERVALUNIT")="Minute"
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDURATIONVALUE")=$P(SIGDATA,U,5)
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDURATIONUNIT")=""
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPRNFLAG")=$P(SIGDATA,U,8)["PRN"
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMOBJECTID")=""
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMTYPETXT")=""
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMDESCRIPTION")=""
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMCODEVALUE")=""
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMCODINGSYSTEM")=""
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMCODINGVERSION")=""
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMSOURCEACTORID")=""
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDSTOPINDICATOR")=""
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDIRSEQ")=DIRNUM
+ . . N DIRMOD S DIRMOD=$P(SIGDATA,U,6)
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDMULDIRMOD")=$S(DIRMOD="T":"THEN",DIRMOD="A":"AND",DIRMOD="X":"EXCEPT",1:"")
+ . ;
+ . ; --- END OF DIRECTIONS ---
+ . ;
+ . ; ^PSRX(22,"INS1",1,0)="FOR BLOOD PRESSURE"
+ . S @MAP@("MEDPTINSTRUCTIONS")=$G(^PSRX(RXIEN,"INS1",1,0))
+ . ; ^PSRX(22,"PRC",1,0)="Pharmacist: you must obey my command"
+ . S @MAP@("MEDFULLFILLMENTINSTRUCTIONS")=$G(^PSRX(RXIEN,"PRC",1,0))
+ . S @MAP@("MEDRFNO")=MED(9)
+ . N RESULT S RESULT=$NA(^TMP("C0CCCR",$J,"MAPPED"))
+ . K @RESULT
+ . D MAP^C0CXPATH(MINXML,MAP,RESULT)
+ . ; MAPPING DIRECTIONS
+ . N DIRXML1 S DIRXML1="MEDDIR1" ; VARIABLE AND NAME VARIABLE TEMPLATE
+ . N DIRXML2 S DIRXML2="MEDDIR2" ; VARIABLE AND NAME VARIABLE RESULT
+ . D QUERY^C0CXPATH(MINXML,"//Medications/Medication/Directions",DIRXML1)
+ . D REPLACE^C0CXPATH(RESULT,"","//Medications/Medication/Directions")
+ . ; N MDZ1,MDZNA
+ . I DIRCNT>0 D  ; IF THERE ARE DIRCTIONS
+ . . F MDZ1=1:1:DIRCNT  D  ; FOR EACH DIRECTION
+ . . . S MDZNA=$NA(@MAP@("M","DIRECTIONS",MDZ1))
+ . . . D MAP^C0CXPATH(DIRXML1,MDZNA,DIRXML2)
+ . . . D INSERT^C0CXPATH(RESULT,DIRXML2,"//Medications/Medication")
+ . I MEDCOUNT=1 D CP^C0CXPATH(RESULT,OUTXML) ; First one is a copy
+ . E  D INSINNER^C0CXPATH(OUTXML,RESULT) ; AFTER FIRST, INSERT INNER XML
+ N MEDTMP,MEDI
+ D MISSING^C0CXPATH(OUTXML,"MEDTMP") ; SEARCH XML FOR MISSING VARS
+ I MEDTMP(0)>0 D  ; IF THERE ARE MISSING VARS - MARKED AS @@X@@
+ . W "MEDICATION MISSING ",!
+ . F MEDI=1:1:MEDTMP(0) W MEDTMP(MEDI),!
+ Q
+ ;

ccr/trunk/p/C0CMED2.m

@@ -1 +1 @@
 C0CMED2 ; WV/CCDCCR/SMH - CCR/CCD Meds - Pending for Vista
-        ;;0.1;CCDCCR;;JUL 16,2008;
-        ;;Last Modified Sat Jan 10 21:41:14 PST 2009
-        ; 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
-        ;
+ ;;1.0;C0C;;May 19, 2009;
+ ;;Last Modified Sat Jan 10 21:41:14 PST 2009
+ ; 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(MINXML,DFN,OUTXML,MEDCOUNT)               ; EXTRACT MEDICATIONS INTO PROVIDED XML TEMPLATE
-        ;
-        ; MINXML is the Input XML Template, passed by name
-        ; DFN is Patient IEN (by Value)
-        ; OUTXML is the resultant XML (by Name)
-        ; MEDCOUNT is the current count of extracted meds, passed by Reference
-        ;
-        ; MEDS is return array from RPC.
-        ; MAP is a mapping variable map (store result) for each med
-        ; MED is holds each array element from MEDS, one medicine
-        ;
-        ; PEN^PSO5241 is a Pharmacy Re-Enginnering (PRE) API to get Pending
-        ; meds data available.
-        ; http://www.va.gov/vdl/documents/Clinical/Pharm-Outpatient_Pharmacy/phar_1_api_r0807.pdf
-        ; Output of API is ^TMP($J,"SUBSCRIPT",DFN,RXIENS).
-        ; File for pending meds is 52.41
-        ; Unfortuantely, API does not supply us with any useful info beyond
-        ; the IEN in 52.41, and the Med Name, and route.
-        ; So, most of the info is going to get pulled from 52.41.
-        N MEDS,MAP
-        K ^TMP($J,"CCDCCR") ; PLEASE DON'T KILL ALL OF ^TMP($J) HERE!!!!
-        D PEN^PSO5241(DFN,"CCDCCR")
-        M MEDS=^TMP($J,"CCDCCR",DFN)
-        ; @(0) contains the number of meds or -1^NO DATA FOUND
-        ; If it is -1, we quit.
-        I $P(MEDS(0),U)=-1 S @OUTXML@(0)=0 QUIT
-        ZWRITE:$G(DEBUG) MEDS
-        N RXIEN S RXIEN=0
-        N MEDFIRST S MEDFIRST=1 ; FLAG FOR FIRST MED IN THIS SECTION FOR MERGING
-        F  S RXIEN=$O(MEDS(RXIEN)) Q:RXIEN="B"  D  ; FOR EACH MEDICATION IN THE LIST
-        . I $$GET1^DIQ(52.41,RXIEN,2,"I")="RF" QUIT  ; Dont' want refill request as a "pending" order
-        . S MEDCOUNT=MEDCOUNT+1
-        . I DEBUG W "RXIEN IS ",RXIEN,!
-        . S MAP=$NA(^TMP("C0CCCR",$J,"MEDMAP",MEDCOUNT))
-        . ; K @MAP DON'T KILL MAP HERE, IT IS DONE IN C0CMED
-        . I DEBUG W "MAP= ",MAP,!
-        . N MED M MED=MEDS(RXIEN) ; PULL OUT MEDICATION FROM
-        . S @MAP@("MEDOBJECTID")="MED_PENDING"_MEDCOUNT ; MEDCOUNT FOR ID
-        . ; S @MAP@("MEDOBJECTID")="MED_PENDING"_MED(.01) ;Pending IEN
-        . S @MAP@("MEDISSUEDATETXT")="Issue Date"
-        . ; Field 6 is "Effective date", and we pull it in timson format w/ I
-        . S @MAP@("MEDISSUEDATE")=$$FMDTOUTC^C0CUTIL($$GET1^DIQ(52.41,RXIEN,6,"I"),"DT")
-        . ; Med never filled; next 4 fields are not applicable.
-        . S @MAP@("MEDLASTFILLDATETXT")=""
-        . S @MAP@("MEDLASTFILLDATE")=""
-        . S @MAP@("MEDRXNOTXT")=""
-        . S @MAP@("MEDRXNO")=""
-        . S @MAP@("MEDTYPETEXT")="Medication"
-        . S @MAP@("MEDDETAILUNADORNED")=""  ; Leave blank, field has its uses
-        . S @MAP@("MEDSTATUSTEXT")="On Hold" ; nearest status for pending meds
-        . S @MAP@("MEDSOURCEACTORID")="ACTORPROVIDER_"_$$GET1^DIQ(52.41,RXIEN,5,"I")
-        . S @MAP@("MEDPRODUCTNAMETEXT")=$P(MED(11),U,2)
-        . ; NDC not supplied in API, but is rather trivial to obtain
-        . ; MED(11) piece 1 has the IEN of the drug (file 50)
-        . ; IEN is field 31 in the drug file.
-        . ;
-        . ; MEDIEN (node 11 in the returned output) might not necessarily be defined
-        . ; It is not defined when a dose in not chosen in CPRS. There is a long
-        . ; series of fields that depend on it. We will use If and Else to deal
-        . ; with that
-        . N MEDIEN S MEDIEN=$P(MED(11),U)
-        . I +MEDIEN>0 D  ; start of if/else block
-        . . ; 12/30/08: I will be using RxNorm for coding...
-        . . ; 176.001 is the file for Concepts; 176.003 is the file for
-        . . ; sources (i.e. for RxNorm Version)
-        . . ;
-        . . ; We need the VUID first for the National Drug File entry first
-        . . ; We get the VUID of the drug, by looking up the VA Product entry
-        . . ; (file 50.68) using the call NDF^PSS50, returned in node 22.
-        . . ; Field 99.99 is the VUID.
-        . . ;
-        . . ; We use the VUID to look up the RxNorm in file 176.001; same idea.
-        . . ; Get IEN first using $$FIND1^DIC, then get the RxNorm number by
-        . . ; $$GET1^DIQ.
-        . . ;
-        . . ; I get the RxNorm name and version from the RxNorm Sources (file
-        . . ; 176.003), by searching for "RXNORM", then get the data.
-        . . D NDF^PSS50(MEDIEN,,,,,"NDF")
-        . . N NDFDATA M NDFDATA=^TMP($J,"NDF",MEDIEN)
-        . . N NDFIEN S NDFIEN=$P(NDFDATA(20),U)
-        . . N VAPROD S VAPROD=$P(NDFDATA(22),U)
-        . . ;
-        . . ; NDFIEN is not necessarily defined; it won't be if the drug
-        . . ; is not matched to the national drug file (e.g. if the drug is
-        . . ; new on the market, compounded, or is a fake drug [blue pill].
-        . . ; To protect against failure, I will put an if/else block
-        . . N VUID,RXNIEN,RXNORM,SRCIEN,RXNNAME,RXNVER
-        . . I NDFIEN,$D(^C0CRXN) D  ; $Data is for Systems that don't have our RxNorm file yet.
-        . . . S VUID=$$GET1^DIQ(50.68,VAPROD,99.99)
-        . . . S RXNIEN=$$FIND1^DIC(176.001,,,VUID,"VUID")
-        . . . S RXNORM=$$GET1^DIQ(176.001,RXNIEN,.01)
-        . . . S SRCIEN=$$FIND1^DIC(176.003,,"B","RXNORM")
-        . . . S RXNNAME=$$GET1^DIQ(176.003,SRCIEN,6)
-        . . . S RXNVER=$$GET1^DIQ(176.003,SRCIEN,7)
-        . . ;
-        . . E  S (RXNORM,RXNNAME,RXNVER)=""
-        . . ; End if/else block
-        . . S @MAP@("MEDPRODUCTNAMECODEVALUE")=RXNORM
-        . . S @MAP@("MEDPRODUCTNAMECODINGINGSYSTEM")=RXNNAME
-        . . S @MAP@("MEDPRODUCTNAMECODEVERSION")=RXNVER
-        . . ;
-        . . S @MAP@("MEDBRANDNAMETEXT")=""
-        . . D DOSE^PSS50(MEDIEN,,,,,"DOSE")
-        . . N DOSEDATA M DOSEDATA=^TMP($J,"DOSE",MEDIEN)
-        . . S @MAP@("MEDSTRENGTHVALUE")=DOSEDATA(901)
-        . . S @MAP@("MEDSTRENGTHUNIT")=$P(DOSEDATA(902),U,2)
-        . . ; Units, concentration, etc, come from another call
-        . . ; $$CPRS^PSNAPIS which returns dosage-form^va class^strengh^unit
-        . . ; This call takes nodes 1 and 3 of ^PSDRUG(D0,"ND") as parameters
-        . . ; NDF Entry IEN, and VA Product Name
-        . . ; These can be obtained using NDF^PSS50 (IEN,,,,,"SUBSCRIPT")
-        . . ; Documented in the same manual; executed above.
-        . . N CONCDATA
-        . . ; If a drug was not matched to NDF, then the NDFIEN is gonna be ""
-        . . ; and this will crash the call. So...
-        . . I NDFIEN="" S CONCDATA=""
-        . . E  S CONCDATA=$$CPRS^PSNAPIS(NDFIEN,VAPROD)
-        . . S @MAP@("MEDFORMTEXT")=$P(CONCDATA,U,1)
-        . . S @MAP@("MEDCONCVALUE")=$P(CONCDATA,U,3)
-        . . S @MAP@("MEDCONCUNIT")=$P(CONCDATA,U,4)
-        . . S @MAP@("MEDQUANTITYVALUE")=$$GET1^DIQ(52.41,RXIEN,12)
-        . . ; Oddly, there is no easy place to find the dispense unit.
-        . . ; It's not included in the original call, so we have to go to the drug file.
-        . . ; That would be DATA^PSS50(IEN,,,,,"SUBSCRIPT")
-        . . ; Node 14.5 is the Dispense Unit
-        . . D DATA^PSS50(MEDIEN,,,,,"QTY")
-        . . N QTYDATA M QTYDATA=^TMP($J,"QTY",MEDIEN)
-        . . S @MAP@("MEDQUANTITYUNIT")=QTYDATA(14.5)
-        . E  D
-        . . S @MAP@("MEDPRODUCTNAMECODEVALUE")=""
-        . . S @MAP@("MEDPRODUCTNAMECODINGINGSYSTEM")=""
-        . . S @MAP@("MEDPRODUCTNAMECODEVERSION")=""
-        . . S @MAP@("MEDBRANDNAMETEXT")=""
-        . . S @MAP@("MEDSTRENGTHVALUE")=""
-        . . S @MAP@("MEDSTRENGTHUNIT")=""
-        . . S @MAP@("MEDFORMTEXT")=""
-        . . S @MAP@("MEDCONCVALUE")=""
-        . . S @MAP@("MEDCONCUNIT")=""
-        . . S @MAP@("MEDSIZETEXT")=""
-        . . S @MAP@("MEDQUANTITYVALUE")=""
-        . . S @MAP@("MEDQUANTITYUNIT")=""
-        . ; end of if/else block
-        . ;
-        . ; --- START OF DIRECTIONS ---
-        . ; Sig data is not in any API. We obtain it using the IEN from
-        . ; the PEN API to file 52.41. It's in field 3, which is a multiple.
-        . ; I will be using FM call GETS^DIQ(FILE,IENS,FIELD,FLAGS,TARGET_ROOT)
-        . K FMSIG ; it's passed via the symbol table, so remove any leftovers from last call
-        . D GETS^DIQ(52.41,RXIEN,"3*",,"FMSIG")
-        . N FMSIGNUM S FMSIGNUM=0 ; Sigline number in fileman.
-        . ; FMSIGNUM gets outputted as "IEN,RXIEN,".
-        . ; DIRNUM will be first piece for IEN.
-        . ; DIRNUM is the proper Sigline numer.
-        . ; SIGDATA is the simplfied array. Subscripts are really field numbers
-        . ; in subfile 52.413.
-        . N DIRCNT S DIRCNT=0 ; COUNT OF DIRECTIONS
-        . F  S FMSIGNUM=$O(FMSIG(52.413,FMSIGNUM)) Q:FMSIGNUM=""  D
-        . . N DIRNUM S DIRNUM=$P(FMSIGNUM,",")
-        . . S DIRCNT=DIRCNT+1 ; INCREMENT DIRECTIONS COUNT
-        . . N SIGDATA M SIGDATA=FMSIG(52.413,FMSIGNUM)
-        . . ; If this is an order for a refill; it's not really a new order; move on to next
-        . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDIRECTIONDESCRIPTIONTEXT")=""  ; This is reserved for systems not able to generate the sig in components.
-        . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDOSEINDICATOR")="1"  ; means that we are specifying it. See E2369-05.
-        . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDELIVERYMETHOD")=SIGDATA(13)
-        . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDOSEVALUE")=SIGDATA(8)
-        . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDOSEUNIT")=@MAP@("MEDCONCUNIT")
-        . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDRATEVALUE")=""  ; For inpatient
-        . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDRATEUNIT")=""  ; For inpatient
-        . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDVEHICLETEXT")=""  ; For inpatient
-        . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDIRECTIONROUTETEXT")=SIGDATA(10)
-        . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDFREQUENCYVALUE")=SIGDATA(1)
-        . . ; Invervals... again another call.
-        . . ; The schedule is a free text field
-        . . ; However, it gets translated by a call to the administration
-        . . ; schedule file to see if that schedule exists.
-        . . ; That's the same thing I am going to do.
-        . . ; The call is AP^PSS51P1(PSSPP,PSSFT,PSSWDIEN,PSSSTPY,LIST,PSSFREQ).
-        . . ; PSSPP is "PSJ" (for some reason, schedules are stored as PSJ, not PSO--
-        . . ; I looked), PSSFT is the name,
-        . . ; and list is the ^TMP name to store the data in.
-        . . ; Also, freqency may have "PRN" in it, so strip that out
-        . . N FREQ S FREQ=SIGDATA(1)
-        . . I FREQ["PRN" S FREQ=$E(FREQ,1,$F(FREQ,"PRN")-5) ; 5 for $L("PRN") + 1 + sp
-        . . D AP^PSS51P1("PSJ",FREQ,,,"SCHEDULE")
-        . . N SCHEDATA M SCHEDATA=^TMP($J,"SCHEDULE")
-        . . N INTERVAL
-        . . I $P(SCHEDATA(0),U)=-1 S INTERVAL=""
-        . . E  D
-        . . . N SUB S SUB=$O(SCHEDATA(0))
-        . . . S INTERVAL=SCHEDATA(SUB,2)
-        . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDINTERVALVALUE")=INTERVAL
-        . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDINTERVALUNIT")="Minute"
-        . . ; Duration comes as M2,H2,D2,W2,L2 for 2 minutes,hours,days,weeks,months
-        . . N DUR S DUR=SIGDATA(2)
-        . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDURATIONVALUE")=$E(DUR,2,$L(DUR))
-        . . N DURUNIT S DURUNIT=$E(DUR)
-        . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDURATIONUNIT")=$S(DURUNIT="M":"Minutes",DURUNIT="H":"Hours",DURUNIT="D":"Days",DURUNIT="W":"Weeks",DURUNIT="L":"Months",1:"")
-        . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPRNFLAG")=SIGDATA(1)["PRN"
-        . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMOBJECTID")=""
-        . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMTYPETXT")=""
-        . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMDESCRIPTION")=""
-        . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMCODEVALUE")=""
-        . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMCODINGSYSTEM")=""
-        . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMCODINGVERSION")=""
-        . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMSOURCEACTORID")=""
-        . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDSTOPINDICATOR")="" ; Vista doesn't have that field
-        . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDIRSEQ")=DIRNUM
-        . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDMULDIRMOD")=SIGDATA(6)
-        . ;
-        . ; --- END OF DIRECTIONS ---
-        . ;
-        . ; S @MAP@("MEDPTINSTRUCTIONS","F")="52.41^105"
-        . S @MAP@("MEDPTINSTRUCTIONS")=$G(^PSRX(RXIEN,"PI",1,0)) ;GPL
-        . ; W @MAP@("MEDPTINSTRUCTIONS"),!
-        . ; S @MAP@("MEDFULLFILLMENTINSTRUCTIONS","F")="52.41^9"
-        . S @MAP@("MEDFULLFILLMENTINSTRUCTIONS")=$G(^PSRX(RXIEN,"SIG1",1,0)) ;GPL
-        . ; W @MAP@("MEDFULLFILLMENTINSTRUCTIONS"),!
-        . S @MAP@("MEDRFNO")=$$GET1^DIQ(52.41,RXIEN,13)
-        . N RESULT S RESULT=$NA(^TMP("C0CCCR",$J,"MAPPED"))
-        . K @RESULT
-        . D MAP^C0CXPATH(MINXML,MAP,RESULT)
-        . ; D PARY^C0CXPATH(RESULT)
-        . ; MAPPING DIRECTIONS
-        . N MEDDIR1,DIRXML1 S DIRXML1="MEDDIR1" ; VARIABLE AND NAME VARIABLE TEMPLATE
-        . N MEDDIR2,DIRXML2 S DIRXML2="MEDDIR2" ; VARIABLE AND NAME VARIABLE RESULT
-        . D QUERY^C0CXPATH(MINXML,"//Medications/Medication/Directions",DIRXML1)
-        . D REPLACE^C0CXPATH(RESULT,"","//Medications/Medication/Directions")
-        . ; N MDZ1,MDZNA
-        . I DIRCNT>0 D  ; IF THERE ARE DIRCTIONS
-        . . F MDZ1=1:1:DIRCNT  D  ; FOR EACH DIRECTION
-        . . . S MDZNA=$NA(@MAP@("M","DIRECTIONS",MDZ1))
-        . . . D MAP^C0CXPATH(DIRXML1,MDZNA,DIRXML2)
-        . . . D INSERT^C0CXPATH(RESULT,DIRXML2,"//Medications/Medication")
-        . I MEDFIRST D  ;
-        . . S MEDFIRST=0 ; RESET FIRST FLAG
-        . . D CP^C0CXPATH(RESULT,OUTXML) ; First one is a copy
-        . D:'MEDFIRST INSINNER^C0CXPATH(OUTXML,RESULT) ; AFTER FIRST, INSERT INNER XML
-        N MEDTMP,MEDI
-        D MISSING^C0CXPATH(OUTXML,"MEDTMP") ; SEARCH XML FOR MISSING VARS
-        I MEDTMP(0)>0 D  ; IF THERE ARE MISSING VARS - MARKED AS @@X@@
-        . W "Pending Medication MISSING ",!
-        . F MEDI=1:1:MEDTMP(0) W MEDTMP(MEDI),!
-        Q
-        ;
+ ;
+ ; MINXML is the Input XML Template, passed by name
+ ; DFN is Patient IEN (by Value)
+ ; OUTXML is the resultant XML (by Name)
+ ; MEDCOUNT is the current count of extracted meds, passed by Reference
+ ;
+ ; MEDS is return array from RPC.
+ ; MAP is a mapping variable map (store result) for each med
+ ; MED is holds each array element from MEDS, one medicine
+ ;
+ ; PEN^PSO5241 is a Pharmacy Re-Enginnering (PRE) API to get Pending
+ ; meds data available.
+ ; http://www.va.gov/vdl/documents/Clinical/Pharm-Outpatient_Pharmacy/phar_1_api_r0807.pdf
+ ; Output of API is ^TMP($J,"SUBSCRIPT",DFN,RXIENS).
+ ; File for pending meds is 52.41
+ ; Unfortuantely, API does not supply us with any useful info beyond
+ ; the IEN in 52.41, and the Med Name, and route.
+ ; So, most of the info is going to get pulled from 52.41.
+ N MEDS,MAP
+ K ^TMP($J,"CCDCCR") ; PLEASE DON'T KILL ALL OF ^TMP($J) HERE!!!!
+ D PEN^PSO5241(DFN,"CCDCCR")
+ M MEDS=^TMP($J,"CCDCCR",DFN)
+ ; @(0) contains the number of meds or -1^NO DATA FOUND
+ ; If it is -1, we quit.
+ I $P(MEDS(0),U)=-1 S @OUTXML@(0)=0 QUIT
+ ZWRITE:$G(DEBUG) MEDS
+ N RXIEN S RXIEN=0
+ N MEDFIRST S MEDFIRST=1 ; FLAG FOR FIRST MED IN THIS SECTION FOR MERGING
+ F  S RXIEN=$O(MEDS(RXIEN)) Q:RXIEN="B"  D  ; FOR EACH MEDICATION IN THE LIST
+ . I $$GET1^DIQ(52.41,RXIEN,2,"I")="RF" QUIT  ; Dont' want refill request as a "pending" order
+ . S MEDCOUNT=MEDCOUNT+1
+ . I DEBUG W "RXIEN IS ",RXIEN,!
+ . S MAP=$NA(^TMP("C0CCCR",$J,"MEDMAP",MEDCOUNT))
+ . ; K @MAP DON'T KILL MAP HERE, IT IS DONE IN C0CMED
+ . I DEBUG W "MAP= ",MAP,!
+ . N MED M MED=MEDS(RXIEN) ; PULL OUT MEDICATION FROM
+ . S @MAP@("MEDOBJECTID")="MED_PENDING"_MEDCOUNT ; MEDCOUNT FOR ID
+ . ; S @MAP@("MEDOBJECTID")="MED_PENDING"_MED(.01) ;Pending IEN
+ . S @MAP@("MEDISSUEDATETXT")="Issue Date"
+ . ; Field 6 is "Effective date", and we pull it in timson format w/ I
+ . S @MAP@("MEDISSUEDATE")=$$FMDTOUTC^C0CUTIL($$GET1^DIQ(52.41,RXIEN,6,"I"),"DT")
+ . ; Med never filled; next 4 fields are not applicable.
+ . S @MAP@("MEDLASTFILLDATETXT")=""
+ . S @MAP@("MEDLASTFILLDATE")=""
+ . S @MAP@("MEDRXNOTXT")=""
+ . S @MAP@("MEDRXNO")=""
+ . S @MAP@("MEDTYPETEXT")="Medication"
+ . S @MAP@("MEDDETAILUNADORNED")=""  ; Leave blank, field has its uses
+ . S @MAP@("MEDSTATUSTEXT")="On Hold" ; nearest status for pending meds
+ . S @MAP@("MEDSOURCEACTORID")="ACTORPROVIDER_"_$$GET1^DIQ(52.41,RXIEN,5,"I")
+ . S @MAP@("MEDPRODUCTNAMETEXT")=$P(MED(11),U,2)
+ . ; NDC not supplied in API, but is rather trivial to obtain
+ . ; MED(11) piece 1 has the IEN of the drug (file 50)
+ . ; IEN is field 31 in the drug file.
+ . ;
+ . ; MEDIEN (node 11 in the returned output) might not necessarily be defined
+ . ; It is not defined when a dose in not chosen in CPRS. There is a long
+ . ; series of fields that depend on it. We will use If and Else to deal
+ . ; with that
+ . N MEDIEN S MEDIEN=$P(MED(11),U)
+ . I +MEDIEN>0 D  ; start of if/else block
+ . . ; 12/30/08: I will be using RxNorm for coding...
+ . . ; 176.001 is the file for Concepts; 176.003 is the file for
+ . . ; sources (i.e. for RxNorm Version)
+ . . ;
+ . . ; We need the VUID first for the National Drug File entry first
+ . . ; We get the VUID of the drug, by looking up the VA Product entry
+ . . ; (file 50.68) using the call NDF^PSS50, returned in node 22.
+ . . ; Field 99.99 is the VUID.
+ . . ;
+ . . ; We use the VUID to look up the RxNorm in file 176.001; same idea.
+ . . ; Get IEN first using $$FIND1^DIC, then get the RxNorm number by
+ . . ; $$GET1^DIQ.
+ . . ;
+ . . ; I get the RxNorm name and version from the RxNorm Sources (file
+ . . ; 176.003), by searching for "RXNORM", then get the data.
+ . . D NDF^PSS50(MEDIEN,,,,,"NDF")
+ . . N NDFDATA M NDFDATA=^TMP($J,"NDF",MEDIEN)
+ . . N NDFIEN S NDFIEN=$P(NDFDATA(20),U)
+ . . N VAPROD S VAPROD=$P(NDFDATA(22),U)
+ . . ;
+ . . ; NDFIEN is not necessarily defined; it won't be if the drug
+ . . ; is not matched to the national drug file (e.g. if the drug is
+ . . ; new on the market, compounded, or is a fake drug [blue pill].
+ . . ; To protect against failure, I will put an if/else block
+ . . N VUID,RXNIEN,RXNORM,SRCIEN,RXNNAME,RXNVER
+ . . I NDFIEN,$D(^C0CRXN) D  ; $Data is for Systems that don't have our RxNorm file yet.
+ . . . S VUID=$$GET1^DIQ(50.68,VAPROD,99.99)
+ . . . S RXNIEN=$$FIND1^DIC(176.001,,,VUID,"VUID")
+ . . . S RXNORM=$$GET1^DIQ(176.001,RXNIEN,.01)
+ . . . S SRCIEN=$$FIND1^DIC(176.003,,"B","RXNORM")
+ . . . S RXNNAME=$$GET1^DIQ(176.003,SRCIEN,6)
+ . . . S RXNVER=$$GET1^DIQ(176.003,SRCIEN,7)
+ . . ;
+ . . E  S (RXNORM,RXNNAME,RXNVER)=""
+ . . ; End if/else block
+ . . S @MAP@("MEDPRODUCTNAMECODEVALUE")=RXNORM
+ . . S @MAP@("MEDPRODUCTNAMECODINGINGSYSTEM")=RXNNAME
+ . . S @MAP@("MEDPRODUCTNAMECODEVERSION")=RXNVER
+ . . ;
+ . . S @MAP@("MEDBRANDNAMETEXT")=""
+ . . D DOSE^PSS50(MEDIEN,,,,,"DOSE")
+ . . N DOSEDATA M DOSEDATA=^TMP($J,"DOSE",MEDIEN)
+ . . S @MAP@("MEDSTRENGTHVALUE")=DOSEDATA(901)
+ . . S @MAP@("MEDSTRENGTHUNIT")=$P(DOSEDATA(902),U,2)
+ . . ; Units, concentration, etc, come from another call
+ . . ; $$CPRS^PSNAPIS which returns dosage-form^va class^strengh^unit
+ . . ; This call takes nodes 1 and 3 of ^PSDRUG(D0,"ND") as parameters
+ . . ; NDF Entry IEN, and VA Product Name
+ . . ; These can be obtained using NDF^PSS50 (IEN,,,,,"SUBSCRIPT")
+ . . ; Documented in the same manual; executed above.
+ . . N CONCDATA
+ . . ; If a drug was not matched to NDF, then the NDFIEN is gonna be ""
+ . . ; and this will crash the call. So...
+ . . I NDFIEN="" S CONCDATA=""
+ . . E  S CONCDATA=$$CPRS^PSNAPIS(NDFIEN,VAPROD)
+ . . S @MAP@("MEDFORMTEXT")=$P(CONCDATA,U,1)
+ . . S @MAP@("MEDCONCVALUE")=$P(CONCDATA,U,3)
+ . . S @MAP@("MEDCONCUNIT")=$P(CONCDATA,U,4)
+ . . S @MAP@("MEDQUANTITYVALUE")=$$GET1^DIQ(52.41,RXIEN,12)
+ . . ; Oddly, there is no easy place to find the dispense unit.
+ . . ; It's not included in the original call, so we have to go to the drug file.
+ . . ; That would be DATA^PSS50(IEN,,,,,"SUBSCRIPT")
+ . . ; Node 14.5 is the Dispense Unit
+ . . D DATA^PSS50(MEDIEN,,,,,"QTY")
+ . . N QTYDATA M QTYDATA=^TMP($J,"QTY",MEDIEN)
+ . . S @MAP@("MEDQUANTITYUNIT")=QTYDATA(14.5)
+ . E  D
+ . . S @MAP@("MEDPRODUCTNAMECODEVALUE")=""
+ . . S @MAP@("MEDPRODUCTNAMECODINGINGSYSTEM")=""
+ . . S @MAP@("MEDPRODUCTNAMECODEVERSION")=""
+ . . S @MAP@("MEDBRANDNAMETEXT")=""
+ . . S @MAP@("MEDSTRENGTHVALUE")=""
+ . . S @MAP@("MEDSTRENGTHUNIT")=""
+ . . S @MAP@("MEDFORMTEXT")=""
+ . . S @MAP@("MEDCONCVALUE")=""
+ . . S @MAP@("MEDCONCUNIT")=""
+ . . S @MAP@("MEDSIZETEXT")=""
+ . . S @MAP@("MEDQUANTITYVALUE")=""
+ . . S @MAP@("MEDQUANTITYUNIT")=""
+ . ; end of if/else block
+ . ;
+ . ; --- START OF DIRECTIONS ---
+ . ; Sig data is not in any API. We obtain it using the IEN from
+ . ; the PEN API to file 52.41. It's in field 3, which is a multiple.
+ . ; I will be using FM call GETS^DIQ(FILE,IENS,FIELD,FLAGS,TARGET_ROOT)
+ . K FMSIG ; it's passed via the symbol table, so remove any leftovers from last call
+ . D GETS^DIQ(52.41,RXIEN,"3*",,"FMSIG")
+ . N FMSIGNUM S FMSIGNUM=0 ; Sigline number in fileman.
+ . ; FMSIGNUM gets outputted as "IEN,RXIEN,".
+ . ; DIRNUM will be first piece for IEN.
+ . ; DIRNUM is the proper Sigline numer.
+ . ; SIGDATA is the simplfied array. Subscripts are really field numbers
+ . ; in subfile 52.413.
+ . N DIRCNT S DIRCNT=0 ; COUNT OF DIRECTIONS
+ . F  S FMSIGNUM=$O(FMSIG(52.413,FMSIGNUM)) Q:FMSIGNUM=""  D
+ . . N DIRNUM S DIRNUM=$P(FMSIGNUM,",")
+ . . S DIRCNT=DIRCNT+1 ; INCREMENT DIRECTIONS COUNT
+ . . N SIGDATA M SIGDATA=FMSIG(52.413,FMSIGNUM)
+ . . ; If this is an order for a refill; it's not really a new order; move on to next
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDIRECTIONDESCRIPTIONTEXT")=""  ; This is reserved for systems not able to generate the sig in components.
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDOSEINDICATOR")="1"  ; means that we are specifying it. See E2369-05.
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDELIVERYMETHOD")=SIGDATA(13)
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDOSEVALUE")=SIGDATA(8)
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDOSEUNIT")=@MAP@("MEDCONCUNIT")
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDRATEVALUE")=""  ; For inpatient
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDRATEUNIT")=""  ; For inpatient
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDVEHICLETEXT")=""  ; For inpatient
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDIRECTIONROUTETEXT")=SIGDATA(10)
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDFREQUENCYVALUE")=SIGDATA(1)
+ . . ; Invervals... again another call.
+ . . ; The schedule is a free text field
+ . . ; However, it gets translated by a call to the administration
+ . . ; schedule file to see if that schedule exists.
+ . . ; That's the same thing I am going to do.
+ . . ; The call is AP^PSS51P1(PSSPP,PSSFT,PSSWDIEN,PSSSTPY,LIST,PSSFREQ).
+ . . ; PSSPP is "PSJ" (for some reason, schedules are stored as PSJ, not PSO--
+ . . ; I looked), PSSFT is the name,
+ . . ; and list is the ^TMP name to store the data in.
+ . . ; Also, freqency may have "PRN" in it, so strip that out
+ . . N FREQ S FREQ=SIGDATA(1)
+ . . I FREQ["PRN" S FREQ=$E(FREQ,1,$F(FREQ,"PRN")-5) ; 5 for $L("PRN") + 1 + sp
+ . . D AP^PSS51P1("PSJ",FREQ,,,"SCHEDULE")
+ . . N SCHEDATA M SCHEDATA=^TMP($J,"SCHEDULE")
+ . . N INTERVAL
+ . . I $P(SCHEDATA(0),U)=-1 S INTERVAL=""
+ . . E  D
+ . . . N SUB S SUB=$O(SCHEDATA(0))
+ . . . S INTERVAL=SCHEDATA(SUB,2)
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDINTERVALVALUE")=INTERVAL
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDINTERVALUNIT")="Minute"
+ . . ; Duration comes as M2,H2,D2,W2,L2 for 2 minutes,hours,days,weeks,months
+ . . N DUR S DUR=SIGDATA(2)
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDURATIONVALUE")=$E(DUR,2,$L(DUR))
+ . . N DURUNIT S DURUNIT=$E(DUR)
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDURATIONUNIT")=$S(DURUNIT="M":"Minutes",DURUNIT="H":"Hours",DURUNIT="D":"Days",DURUNIT="W":"Weeks",DURUNIT="L":"Months",1:"")
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPRNFLAG")=SIGDATA(1)["PRN"
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMOBJECTID")=""
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMTYPETXT")=""
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMDESCRIPTION")=""
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMCODEVALUE")=""
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMCODINGSYSTEM")=""
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMCODINGVERSION")=""
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMSOURCEACTORID")=""
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDSTOPINDICATOR")="" ; Vista doesn't have that field
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDIRSEQ")=DIRNUM
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDMULDIRMOD")=SIGDATA(6)
+ . ;
+ . ; --- END OF DIRECTIONS ---
+ . ;
+ . ; S @MAP@("MEDPTINSTRUCTIONS","F")="52.41^105"
+ . S @MAP@("MEDPTINSTRUCTIONS")=$G(^PSRX(RXIEN,"PI",1,0)) ;GPL
+ . ; W @MAP@("MEDPTINSTRUCTIONS"),!
+ . ; S @MAP@("MEDFULLFILLMENTINSTRUCTIONS","F")="52.41^9"
+ . S @MAP@("MEDFULLFILLMENTINSTRUCTIONS")=$G(^PSRX(RXIEN,"SIG1",1,0)) ;GPL
+ . ; W @MAP@("MEDFULLFILLMENTINSTRUCTIONS"),!
+ . S @MAP@("MEDRFNO")=$$GET1^DIQ(52.41,RXIEN,13)
+ . N RESULT S RESULT=$NA(^TMP("C0CCCR",$J,"MAPPED"))
+ . K @RESULT
+ . D MAP^C0CXPATH(MINXML,MAP,RESULT)
+ . ; D PARY^C0CXPATH(RESULT)
+ . ; MAPPING DIRECTIONS
+ . N MEDDIR1,DIRXML1 S DIRXML1="MEDDIR1" ; VARIABLE AND NAME VARIABLE TEMPLATE
+ . N MEDDIR2,DIRXML2 S DIRXML2="MEDDIR2" ; VARIABLE AND NAME VARIABLE RESULT
+ . D QUERY^C0CXPATH(MINXML,"//Medications/Medication/Directions",DIRXML1)
+ . D REPLACE^C0CXPATH(RESULT,"","//Medications/Medication/Directions")
+ . ; N MDZ1,MDZNA
+ . I DIRCNT>0 D  ; IF THERE ARE DIRCTIONS
+ . . F MDZ1=1:1:DIRCNT  D  ; FOR EACH DIRECTION
+ . . . S MDZNA=$NA(@MAP@("M","DIRECTIONS",MDZ1))
+ . . . D MAP^C0CXPATH(DIRXML1,MDZNA,DIRXML2)
+ . . . D INSERT^C0CXPATH(RESULT,DIRXML2,"//Medications/Medication")
+ . I MEDFIRST D  ;
+ . . S MEDFIRST=0 ; RESET FIRST FLAG
+ . . D CP^C0CXPATH(RESULT,OUTXML) ; First one is a copy
+ . D:'MEDFIRST INSINNER^C0CXPATH(OUTXML,RESULT) ; AFTER FIRST, INSERT INNER XML
+ N MEDTMP,MEDI
+ D MISSING^C0CXPATH(OUTXML,"MEDTMP") ; SEARCH XML FOR MISSING VARS
+ I MEDTMP(0)>0 D  ; IF THERE ARE MISSING VARS - MARKED AS @@X@@
+ . W "Pending Medication MISSING ",!
+ . F MEDI=1:1:MEDTMP(0) W MEDTMP(MEDI),!
+ Q
+ ;

ccr/trunk/p/C0CMED3.m

@@ -1 @@
-C0CMED3 ; WV/CCDCCR/SMH - Meds: Non-VA/Outside Meds for Vista
- ;;0.1;CCDCCR;;;
+C0CMED3 ; WV/CCDCCR/SMH - Meds: Non-VA/Outside Meds for Vista
+ ;;1.0;C0C;;May 19, 2009;
  ;;Last Modified: Sun Jan 11 05:45:03 UTC 2009
  ; Copyright 2009 WorldVistA.  Licensed under the terms of the GNU
@@ -22 +22 @@
  Q
  ;
-EXTRACT(MINXML,DFN,OUTXML,MEDCOUNT) ; Extract medications into provided xml template
+EXTRACT(MINXML,DFN,OUTXML,MEDCOUNT)     ; Extract medications into provided xml template
  ;
  ; MINXML is the Input XML Template, (passed by name)

ccr/trunk/p/C0CMED6.m

@@ -1 +1 @@
 C0CMED6 ; WV/CCDCCR/SMH - Meds from RPMS: Outpatient Meds;01/10/09
-        ;;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
-        ;
+ ;;1.0;C0C;;May 19, 2009;
+ ; 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(MINXML,DFN,OUTXML,FLAGS)         ; EXTRACT MEDICATIONS INTO PROVIDED XML TEMPLATE
-        ;
-        ; MINXML and OUTXML are passed by name so globals can be used
-        ; MINXML will contain only the medications skeleton of the overall template
-        ; FLAGS are: MEDALL(bool)^MEDLIMIT(int)^MEDACTIVE(bool)^MEDPENDING(bool)
-        ; FLAGS are set-up in C0CMED.
-        ;
-        ; MEDS is return array from RPC.
-        ; MAP is a mapping variable map (store result) for each med
-        ; MED is holds each array element from MEDS(J), one medicine
-        ; J is a counter.
-        ;
-        ; GETRXS^BEHORXFN(ARRAYNAME,DFN,DAYS) will be the the API used.
-        ; This API has been developed by Medsphere for IHS for getting
-        ; Medications from RPMS. It has most of what we need.
-        ; API written by Doug Martin when he worked for Medsphere (thanks Doug!)
-        ; -- ARRAYNAME is passed by name (required)
-        ; -- DFN is passed by value (required)
-        ; -- DAYS is passed by value (optional; if not passed defaults to 365)
-        ; 
-        ; Return:
-        ; ~Type^PharmID^Drug^InfRate^StopDt^RefRem^TotDose^UnitDose^OrderID 
-        ; ^Status^LastFill^Chronic^Issued^Rx #^Provider^ 
-        ; Status Reason^DEA Handling
-        ; 
-        N MEDS,MEDS1,MAP
-        D GETRXS^BEHORXFN("MEDS1",DFN,$P($P(FLAGS,U,2),"-",2)) ; 2nd piece of FLAGS is # of days to retrieve, which comes in the form "T-360"
-        N ALL S ALL=+FLAGS
-        N ACTIVE S ACTIVE=$P(FLAGS,U,3)
-        N PENDING S PENDING=$P(FLAGS,U,4)
-        S @OUTXML@(0)=0  ;By default, no meds
-        ; If MEDS1 is not defined, then no meds
-        I '$D(MEDS1) QUIT
-        I DEBUG ZWR MEDS1,MINXML
-        N MEDCNT S MEDCNT=0 ; Med Count
-        ; The next line is a super line. It goes through the array return
-        ; and if the first characters are ~OP, it grabs the line.
-        ; This means that line is for a dispensed Outpatient Med.
-        ; That line has the metadata about the med that I need.
-        ; The next lines, however many, are the med and the sig.
-        ; I won't be using those because I have to get the sig parsed exactly.
-        N J S J="" F  S J=$O(MEDS1(J)) Q:J=""  I $E(MEDS1(J),1,3)="~OP" S MEDCNT=MEDCNT+1 S MEDS(MEDCNT)=MEDS1(J)
-        K MEDS1
-        S MEDCNT="" ; Initialize for $Order
-        F  S MEDCNT=$O(MEDS(MEDCNT)) Q:MEDCNT=""  D  ; for each medication in the list
-        . I 'ALL,ACTIVE,$P(MEDS(MEDCNT),U,10)'="ACTIVE" QUIT
-        . I 'ALL,PENDING,$P(MEDS(MEDCNT),U,10)'="PENDING" QUIT
-        . I DEBUG W "MEDCNT IS ",MEDCNT,!
-        . S MAP=$NA(^TMP("C0CCCR",$J,"MEDMAP",MEDCNT))
-        . ; K @MAP DO NOT KILL HERE, WAS CLEARED IN C0CMED
-        . I DEBUG W "MAP= ",MAP,!
-        . S @MAP@("MEDOBJECTID")="MED"_MEDCNT ; MEDCNT FOR ID
-        . S @MAP@("MEDISSUEDATETXT")="Issue Date"
-        . S @MAP@("MEDISSUEDATE")=$$FMDTOUTC^C0CUTIL($P(MEDS(MEDCNT),U,13))
-        . S @MAP@("MEDLASTFILLDATETXT")="Last Fill Date"
-        . S @MAP@("MEDLASTFILLDATE")=$$FMDTOUTC^C0CUTIL($P(MEDS(MEDCNT),U,11))
-        . S @MAP@("MEDRXNOTXT")="Prescription Number"
-        . S @MAP@("MEDRXNO")=$P(MEDS(MEDCNT),U,14)
-        . S @MAP@("MEDTYPETEXT")="Medication"
-        . S @MAP@("MEDDETAILUNADORNED")=""  ; Leave blank, field has its uses
-        . S @MAP@("MEDSTATUSTEXT")=$P(MEDS(MEDCNT),U,10)
-        . ; Provider only provided in API as text, not DUZ.
-        . ; We need to get DUZ from filman file 52 (Prescription)
-        . ; Field 4; IEN is Piece 2 of Meds stripped of trailing characters.
-        . ; Note that I will use RXIEN several times later
-        . N RXIEN S RXIEN=+$P(MEDS(MEDCNT),U,2)
-        . S @MAP@("MEDSOURCEACTORID")="ACTORPROVIDER_"_$$GET1^DIQ(52,RXIEN,4,"I")
-        . S @MAP@("MEDPRODUCTNAMETEXT")=$P(MEDS(MEDCNT),U,3)
-        . ; --- RxNorm Stuff 
-        . ; 176.001 is the file for Concepts; 176.003 is the file for
-        . ; sources (i.e. for RxNorm Version)
-        . ; 
-        . ; I use 176.001 for the Vista version of this routine (files 1-3)
-        . ; Since IHS does not have VUID's, I will be getting RxNorm codes
-        . ; using NDCs. My specially crafted index (sounds evil) named "NDC"
-        . ; is in file 176.002. The file is called RxNorm NDC to VUID.
-        . ; Except that I don't need the VUID, but it's there if I need it.
-        . ; 
-        . ; We obviously need the NDC. That is easily obtained from the prescription.
-        . ; Field 27 in file 52
-        . N NDC S NDC=$$GET1^DIQ(52,RXIEN,27,"I")
-        . ; I discovered that file 176.002 might give you two codes for the NDC
-        . ; One for the Clinical Drug, and one for the ingredient.
-        . ; So the plan is to get the two RxNorm codes, and then find from
-        . ; file 176.001 which one is the Clinical Drug.
-        . ; ... I refactored this into GETRXN
-        . N RXNORM,SRCIEN,RXNNAME,RXNVER
-        . I +NDC,$D(^C0CRXN) D  ; $Data is for Systems that don't have our RxNorm file yet.
-        . . S RXNORM=$$GETRXN(NDC)
-        . . S SRCIEN=$$FIND1^DIC(176.003,,,"RXNORM","B")
-        . . S RXNNAME=$$GET1^DIQ(176.003,SRCIEN,6)
-        . . S RXNVER=$$GET1^DIQ(176.003,SRCIEN,7)
-        . ;
-        . E  S (RXNORM,RXNNAME,RXNVER)=""
-        . ; End if/else block
-        . S @MAP@("MEDPRODUCTNAMECODEVALUE")=RXNORM
-        . S @MAP@("MEDPRODUCTNAMECODINGINGSYSTEM")=RXNNAME
-        . S @MAP@("MEDPRODUCTNAMECODEVERSION")=RXNVER
-        . ; --- End RxNorm section
-        . ;
-        . ; Brand name is 52 field 6.5
-        . S @MAP@("MEDBRANDNAMETEXT")=$$GET1^DIQ(52,RXIEN,6.5)
-        . ;
-        . ; Next I need Med Form (tab, cap etc), strength (250mg)
-        . ; concentration for liquids (250mg/mL)
-        . ; Since IHS does not have any of the new calls that 
-        . ; Vista has, I will be doing a crosswalk:
-        . ; File 52, field 6 is Drug IEN in file 50
-        . ; File 50, field 22 is VA Product IEN in file 50.68
-        . ; In file 50.68, I will get the following:
-        . ; -- 1: Dosage Form
-        . ; -- 2: Strength
-        . ; -- 3: Units
-        . ; -- 8: Dispense Units
-        . ; -- Conc is 2 concatenated with 3
-        . ; 
-        . ; *** If Drug is not matched to NDF, then VA Product will be "" ***
-        . ;
-        . N MEDIEN S MEDIEN=$$GET1^DIQ(52,RXIEN,6,"I") ; Drug IEN in 50
-        . N VAPROD S VAPROD=$$GET1^DIQ(50,MEDIEN,22,"I") ; VA Product in file 50.68
-        . I +VAPROD D
-        . . S @MAP@("MEDSTRENGTHVALUE")=$$GET1^DIQ(50.68,VAPROD,2)
-        . . S @MAP@("MEDSTRENGTHUNIT")=$$GET1^DIQ(50.68,VAPROD,3)
-        . . S @MAP@("MEDFORMTEXT")=$$GET1^DIQ(50.68,VAPROD,1)
-        . . S @MAP@("MEDCONCVALUE")=@MAP@("MEDSTRENGTHVALUE")
-        . . S @MAP@("MEDCONCUNIT")=@MAP@("MEDSTRENGTHUNIT")
-        . E  D
-        . . S @MAP@("MEDSTRENGTHVALUE")=""
-        . . S @MAP@("MEDSTRENGTHUNIT")=""
-        . . S @MAP@("MEDFORMTEXT")=""
-        . . S @MAP@("MEDCONCVALUE")=""
-        . . S @MAP@("MEDCONCUNIT")=""
-        . ; End Strengh/Conc stuff
-        . ;
-        . ; Quantity is in the prescription, field 7
-        . S @MAP@("MEDQUANTITYVALUE")=$$GET1^DIQ(52,RXIEN,7)
-        . ; Dispense unit is in the drug file, field 14.5
-        . S @MAP@("MEDQUANTITYUNIT")=$$GET1^DIQ(50,MEDIEN,14.5)
-        . ;
-        . ; --- START OF DIRECTIONS ---
-        . ; Sig data not in any API :-(  Oh yes, you can get the whole thing, but...
-        . ; we want the components.
-        . ; It's in multiple 113 in the Prescription File (52)
-        . ; #.01 DOSAGE ORDERED [1F]                    "20"
-        . ; #1 DISPENSE UNITS PER DOSE [2N]     "1"
-        . ; #2 UNITS [3P:50.607]                                "MG"
-        . ; #3 NOUN [4F]                                                "TABLET"
-        . ; #4 DURATION [5F]                                    "10D"
-        . ; #5 CONJUNCTION [6S]                                 "AND"
-        . ; #6 ROUTE [7P:51.2]                          "ORAL"
-        . ; #7 SCHEDULE [8F]                                    "BID"
-        . ; #8 VERB [9F]                                                "TAKE"
-        . ;
-        . ; Will use GETS^DIQ to get fields.
-        . ; Data comes out like this:
-        . ; SAMINS(52.0113,"1,23,",.01)=20
-        . ; SAMINS(52.0113,"1,23,",1)=1
-        . ; SAMINS(52.0113,"1,23,",2)="MG"
-        . ; SAMINS(52.0113,"1,23,",3)="TABLET"
-        . ; SAMINS(52.0113,"1,23,",4)="5D"
-        . ; SAMINS(52.0113,"1,23,",5)="THEN"
-        . ;
-        . N RAWDATA
-        . D GETS^DIQ(52,RXIEN,"113*",,"RAWDATA","DIERR")
-        . D:$D(DIERR) ^%ZTER  ; Log if there's an error in retrieving sig field
-        . ; none the less, continue; some parts are retrievable.
-        . N FMSIG M FMSIG=RAWDATA(52.0113) ; Merge into subfile...
-        . K RAWDATA
-        . N FMSIGNUM S FMSIGNUM="" ; Sigline number in fileman.
-        . ; FMSIGNUM gets outputted as "IEN,RXIEN,".
-        . ; DIRCNT is the proper Sigline numer.
-        . ; SIGDATA is the simplfied array. 
-        . F  S FMSIGNUM=$O(FMSIG(FMSIGNUM)) Q:FMSIGNUM=""  D
-        . . N DIRCNT S DIRCNT=$P(FMSIGNUM,",")
-        . . N SIGDATA M SIGDATA=FMSIG(FMSIGNUM)
-        . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDIRECTIONDESCRIPTIONTEXT")=""  ; This is reserved for systems not able to generate the sig in components.
-        . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDOSEINDICATOR")="1"  ; means that we are specifying it. See E2369-05.
-        . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDELIVERYMETHOD")=$G(SIGDATA(8))
-        . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDOSEVALUE")=$G(SIGDATA(.01))
-        . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDOSEUNIT")=$G(SIGDATA(2))
-        . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDRATEVALUE")=""  ; For inpatient
-        . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDRATEUNIT")=""  ; For inpatient
-        . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDVEHICLETEXT")=""  ; For inpatient
-        . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDIRECTIONROUTETEXT")=$G(SIGDATA(6))
-        . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDFREQUENCYVALUE")=$G(SIGDATA(7))
-        . . ; Invervals... again another call.
-        . . ; In the wisdom of the original programmers, the schedule is a free text field
-        . . ; However, it gets translated by a call to the administration schedule file
-        . . ; to see if that schedule exists.
-        . . ; That's the same thing I am going to do.
-        . . ; Search B index of 51.1 (Admin Schedule) with schedule
-        . . ; First, remove "PRN" if it exists (don't ask, that's how the file
-        . . ; works; I wouldn't do it that way).
-        . . N SCHNOPRN S SCHNOPRN=$G(SIGDATA(7))
-        . . I SCHNOPRN["PRN" S SCHNOPRN=$E(SCHNOPRN,1,$F(SCHNOPRN,"PRN")-5)
-        . . ; Super call below:
-        . . ; 1=File 51.1 3=Field 2 (Frequency in Minutes)
-        . . ; 4=Packed format, Exact Match 5=Lookup Value
-        . . ; 6=# of entries to return 7=Index 10=Return Array
-        . . ; 
-        . . ; I do not account for the fact that two schedules can be
-        . . ; spelled identically (ie duplicate entry). In that case,
-        . . ; I get the first. That's just a bad pharmacy pkg maintainer.
-        . . N C0C515
-        . . D FIND^DIC(51.1,,"@;2","PX",SCHNOPRN,1,"B",,,"C0C515")
-        . . N INTERVAL S INTERVAL="" ; Default
-        . . ; If there are entries found, get it
-        . . I +$G(C0C515("DILIST",0)) S INTERVAL=$P(C0C515("DILIST",1,0),U,2) 
-        . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDINTERVALVALUE")=INTERVAL
-        . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDINTERVALUNIT")="Minute"
-        . . ; Duration is 10M minutes, 10H hours, 10D for Days
-        . . ; 10W for weeks, 10L for months. I smell $Select
-        . . ; But we don't need to do that if there isn't a duration
-        . . I +$G(SIGDATA(4)) D
-        . . . N DURUNIT S DURUNIT=$E(SIGDATA(4),$L(SIGDATA(4))) ; get last char
-        . . . N DURTXT S DURTXT=$S(DURUNIT="M":"Minutes",DURUNIT="H":"Hours",DURUNIT="D":"Days",DURUNIT="W":"Weeks",DURUNIT="L":"Months",1:"Days")
-        . . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDURATIONVALUE")=+SIGDATA(4)
-        . . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDURATIONUNIT")=DURTXT
-        . . E  D
-        . . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDURATIONVALUE")=""
-        . . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDURATIONUNIT")=""
-        . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPRNFLAG")=$G(SIGDATA(4))["PRN"
-        . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMOBJECTID")="" ; when avail
-        . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMTYPETXT")=""
-        . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMDESCRIPTION")=""
-        . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMCODEVALUE")=""
-        . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMCODINGSYSTEM")=""
-        . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMCODINGVERSION")=""
-        . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMSOURCEACTORID")=""
-        . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDSTOPINDICATOR")="" ; not stored
-        . . ; Another confusing line; I am pretty bad:
-        . . ; If there is another entry in the FMSIG array (i.e. another line
-        . . ; in the sig), set the direction count indicator.
-        . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDIRSEQ")=""  ; Default
-        . . S:+$O(FMSIG(FMSIGNUM)) @MAP@("M","DIRECTIONS",DIRCNT,"MEDDIRSEQ")=DIRCNT
-        . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDMULDIRMOD")=$G(SIGDATA(5))
-        . ;
-        . ; --- END OF DIRECTIONS ---
-        . ;
-        . ; Med instructions is a WP field, thus the acrobatics
-        . ; Notice buffer overflow protection set at 10,000 chars
-        . ; -- 1. Med Patient Instructions
-        . N MEDPTIN1 S MEDPTIN1=$$GET1^DIQ(52,RXIEN,115,,"MEDPTIN1")
-        . N MEDPTIN2,J  S (MEDPTIN2,J)="" 
-        . I $L(MEDPTIN1) F  S J=$O(@MEDPTIN1@(J)) Q:J=""  Q:$L(MEDPTIN2)>10000  S MEDPTIN2=MEDPTIN2_@MEDPTIN1@(J)_" "
-        . S @MAP@("MEDPTINSTRUCTIONS")=MEDPTIN2
-        . K J
-        . ; -- 2. Med Provider Instructions
-        . N MEDPVIN1 S MEDPVIN1=$$GET1^DIQ(52,RXIEN,39,,"MEDPVIN1")
-        . N MEDPVIN2,J S (MEDPVIN2,J)=""
-        . I $L(MEDPVIN1) F  S J=$O(@MEDPVIN1@(J)) Q:J=""  Q:$L(MEDPVIN2)>10000  S MEDPVIN2=MEDPVIN2_@MEDPVIN1@(J)_" "
-        . S @MAP@("MEDFULLFILLMENTINSTRUCTIONS")=MEDPVIN2
-        . ;
-        . ; Remaining refills
-        . S @MAP@("MEDRFNO")=$P(MEDS(MEDCNT),U,6)
-        . ; ------ END OF MAPPING
-        . ;
-        . ; ------ BEGIN XML INSERTION
-        . N RESULT S RESULT=$NA(^TMP("C0CCCR",$J,"MAPPED"))
-        . K @RESULT
-        . D MAP^C0CXPATH(MINXML,MAP,RESULT)
-        . ; D PARY^C0CXPATH(RESULT)
-        . ; MAPPING DIRECTIONS
-        . N MEDDIR1,DIRXML1 S DIRXML1="MEDDIR1" ; VARIABLE AND NAME VARIABLE TEMPLATE
-        . N MEDDIR2,DIRXML2 S DIRXML2="MEDDIR2" ; VARIABLE AND NAME VARIABLE RESULT
-        . D QUERY^C0CXPATH(MINXML,"//Medications/Medication/Directions",DIRXML1)
-        . D REPLACE^C0CXPATH(RESULT,"","//Medications/Medication/Directions")
-        . ; N MDZ1,MDZNA
-        . N DIRCNT S DIRCNT=""
-        . I +$O(@MAP@("M","DIRECTIONS",DIRCNT)) D  ; IF THERE ARE DIRCTIONS
-        . . F DIRCNT=$O(@MAP@("M","DIRECTIONS",DIRCNT)) D  ; FOR EACH DIRECTION
-        . . . S MDZNA=$NA(@MAP@("M","DIRECTIONS",DIRCNT))
-        . . . D MAP^C0CXPATH(DIRXML1,MDZNA,DIRXML2)
-        . . . D INSERT^C0CXPATH(RESULT,DIRXML2,"//Medications/Medication")
-        . D:MEDCNT=1 CP^C0CXPATH(RESULT,OUTXML) ; First one is a copy
-        . D:MEDCNT>1 INSINNER^C0CXPATH(OUTXML,RESULT) ; AFTER THE FIRST, INSERT INNER XML
-        N MEDTMP,MEDI
-        D MISSING^C0CXPATH(OUTXML,"MEDTMP") ; SEARCH XML FOR MISSING VARS
-        I MEDTMP(0)>0 D  ; IF THERE ARE MISSING VARS - MARKED AS @@X@@
-        . W "MEDICATION MISSING ",!
-        . F MEDI=1:1:MEDTMP(0) W MEDTMP(MEDI),!
-        Q
-        ;
+ ;
+ ; MINXML and OUTXML are passed by name so globals can be used
+ ; MINXML will contain only the medications skeleton of the overall template
+ ; FLAGS are: MEDALL(bool)^MEDLIMIT(int)^MEDACTIVE(bool)^MEDPENDING(bool)
+ ; FLAGS are set-up in C0CMED.
+ ;
+ ; MEDS is return array from RPC.
+ ; MAP is a mapping variable map (store result) for each med
+ ; MED is holds each array element from MEDS(J), one medicine
+ ; J is a counter.
+ ;
+ ; GETRXS^BEHORXFN(ARRAYNAME,DFN,DAYS) will be the the API used.
+ ; This API has been developed by Medsphere for IHS for getting
+ ; Medications from RPMS. It has most of what we need.
+ ; API written by Doug Martin when he worked for Medsphere (thanks Doug!)
+ ; -- ARRAYNAME is passed by name (required)
+ ; -- DFN is passed by value (required)
+ ; -- DAYS is passed by value (optional; if not passed defaults to 365)
+ ; 
+ ; Return:
+ ; ~Type^PharmID^Drug^InfRate^StopDt^RefRem^TotDose^UnitDose^OrderID 
+ ; ^Status^LastFill^Chronic^Issued^Rx #^Provider^ 
+ ; Status Reason^DEA Handling
+ ; 
+ N MEDS,MEDS1,MAP
+ D GETRXS^BEHORXFN("MEDS1",DFN,$P($P(FLAGS,U,2),"-",2)) ; 2nd piece of FLAGS is # of days to retrieve, which comes in the form "T-360"
+ N ALL S ALL=+FLAGS
+ N ACTIVE S ACTIVE=$P(FLAGS,U,3)
+ N PENDING S PENDING=$P(FLAGS,U,4)
+ S @OUTXML@(0)=0  ;By default, no meds
+ ; If MEDS1 is not defined, then no meds
+ I '$D(MEDS1) QUIT
+ I DEBUG ZWR MEDS1,MINXML
+ N MEDCNT S MEDCNT=0 ; Med Count
+ ; The next line is a super line. It goes through the array return
+ ; and if the first characters are ~OP, it grabs the line.
+ ; This means that line is for a dispensed Outpatient Med.
+ ; That line has the metadata about the med that I need.
+ ; The next lines, however many, are the med and the sig.
+ ; I won't be using those because I have to get the sig parsed exactly.
+ N J S J="" F  S J=$O(MEDS1(J)) Q:J=""  I $E(MEDS1(J),1,3)="~OP" S MEDCNT=MEDCNT+1 S MEDS(MEDCNT)=MEDS1(J)
+ K MEDS1
+ S MEDCNT="" ; Initialize for $Order
+ F  S MEDCNT=$O(MEDS(MEDCNT)) Q:MEDCNT=""  D  ; for each medication in the list
+ . I 'ALL,ACTIVE,$P(MEDS(MEDCNT),U,10)'="ACTIVE" QUIT
+ . I 'ALL,PENDING,$P(MEDS(MEDCNT),U,10)'="PENDING" QUIT
+ . I DEBUG W "MEDCNT IS ",MEDCNT,!
+ . S MAP=$NA(^TMP("C0CCCR",$J,"MEDMAP",MEDCNT))
+ . ; K @MAP DO NOT KILL HERE, WAS CLEARED IN C0CMED
+ . I DEBUG W "MAP= ",MAP,!
+ . S @MAP@("MEDOBJECTID")="MED"_MEDCNT ; MEDCNT FOR ID
+ . S @MAP@("MEDISSUEDATETXT")="Issue Date"
+ . S @MAP@("MEDISSUEDATE")=$$FMDTOUTC^C0CUTIL($P(MEDS(MEDCNT),U,13))
+ . S @MAP@("MEDLASTFILLDATETXT")="Last Fill Date"
+ . S @MAP@("MEDLASTFILLDATE")=$$FMDTOUTC^C0CUTIL($P(MEDS(MEDCNT),U,11))
+ . S @MAP@("MEDRXNOTXT")="Prescription Number"
+ . S @MAP@("MEDRXNO")=$P(MEDS(MEDCNT),U,14)
+ . S @MAP@("MEDTYPETEXT")="Medication"
+ . S @MAP@("MEDDETAILUNADORNED")=""  ; Leave blank, field has its uses
+ . S @MAP@("MEDSTATUSTEXT")=$P(MEDS(MEDCNT),U,10)
+ . ; Provider only provided in API as text, not DUZ.
+ . ; We need to get DUZ from filman file 52 (Prescription)
+ . ; Field 4; IEN is Piece 2 of Meds stripped of trailing characters.
+ . ; Note that I will use RXIEN several times later
+ . N RXIEN S RXIEN=+$P(MEDS(MEDCNT),U,2)
+ . S @MAP@("MEDSOURCEACTORID")="ACTORPROVIDER_"_$$GET1^DIQ(52,RXIEN,4,"I")
+ . S @MAP@("MEDPRODUCTNAMETEXT")=$P(MEDS(MEDCNT),U,3)
+ . ; --- RxNorm Stuff 
+ . ; 176.001 is the file for Concepts; 176.003 is the file for
+ . ; sources (i.e. for RxNorm Version)
+ . ; 
+ . ; I use 176.001 for the Vista version of this routine (files 1-3)
+ . ; Since IHS does not have VUID's, I will be getting RxNorm codes
+ . ; using NDCs. My specially crafted index (sounds evil) named "NDC"
+ . ; is in file 176.002. The file is called RxNorm NDC to VUID.
+ . ; Except that I don't need the VUID, but it's there if I need it.
+ . ; 
+ . ; We obviously need the NDC. That is easily obtained from the prescription.
+ . ; Field 27 in file 52
+ . N NDC S NDC=$$GET1^DIQ(52,RXIEN,27,"I")
+ . ; I discovered that file 176.002 might give you two codes for the NDC
+ . ; One for the Clinical Drug, and one for the ingredient.
+ . ; So the plan is to get the two RxNorm codes, and then find from
+ . ; file 176.001 which one is the Clinical Drug.
+ . ; ... I refactored this into GETRXN
+ . N RXNORM,SRCIEN,RXNNAME,RXNVER
+ . I +NDC,$D(^C0CRXN) D  ; $Data is for Systems that don't have our RxNorm file yet.
+ . . S RXNORM=$$GETRXN(NDC)
+ . . S SRCIEN=$$FIND1^DIC(176.003,,,"RXNORM","B")
+ . . S RXNNAME=$$GET1^DIQ(176.003,SRCIEN,6)
+ . . S RXNVER=$$GET1^DIQ(176.003,SRCIEN,7)
+ . ;
+ . E  S (RXNORM,RXNNAME,RXNVER)=""
+ . ; End if/else block
+ . S @MAP@("MEDPRODUCTNAMECODEVALUE")=RXNORM
+ . S @MAP@("MEDPRODUCTNAMECODINGINGSYSTEM")=RXNNAME
+ . S @MAP@("MEDPRODUCTNAMECODEVERSION")=RXNVER
+ . ; --- End RxNorm section
+ . ;
+ . ; Brand name is 52 field 6.5
+ . S @MAP@("MEDBRANDNAMETEXT")=$$GET1^DIQ(52,RXIEN,6.5)
+ . ;
+ . ; Next I need Med Form (tab, cap etc), strength (250mg)
+ . ; concentration for liquids (250mg/mL)
+ . ; Since IHS does not have any of the new calls that 
+ . ; Vista has, I will be doing a crosswalk:
+ . ; File 52, field 6 is Drug IEN in file 50
+ . ; File 50, field 22 is VA Product IEN in file 50.68
+ . ; In file 50.68, I will get the following:
+ . ; -- 1: Dosage Form
+ . ; -- 2: Strength
+ . ; -- 3: Units
+ . ; -- 8: Dispense Units
+ . ; -- Conc is 2 concatenated with 3
+ . ; 
+ . ; *** If Drug is not matched to NDF, then VA Product will be "" ***
+ . ;
+ . N MEDIEN S MEDIEN=$$GET1^DIQ(52,RXIEN,6,"I") ; Drug IEN in 50
+ . N VAPROD S VAPROD=$$GET1^DIQ(50,MEDIEN,22,"I") ; VA Product in file 50.68
+ . I +VAPROD D
+ . . S @MAP@("MEDSTRENGTHVALUE")=$$GET1^DIQ(50.68,VAPROD,2)
+ . . S @MAP@("MEDSTRENGTHUNIT")=$$GET1^DIQ(50.68,VAPROD,3)
+ . . S @MAP@("MEDFORMTEXT")=$$GET1^DIQ(50.68,VAPROD,1)
+ . . S @MAP@("MEDCONCVALUE")=@MAP@("MEDSTRENGTHVALUE")
+ . . S @MAP@("MEDCONCUNIT")=@MAP@("MEDSTRENGTHUNIT")
+ . E  D
+ . . S @MAP@("MEDSTRENGTHVALUE")=""
+ . . S @MAP@("MEDSTRENGTHUNIT")=""
+ . . S @MAP@("MEDFORMTEXT")=""
+ . . S @MAP@("MEDCONCVALUE")=""
+ . . S @MAP@("MEDCONCUNIT")=""
+ . ; End Strengh/Conc stuff
+ . ;
+ . ; Quantity is in the prescription, field 7
+ . S @MAP@("MEDQUANTITYVALUE")=$$GET1^DIQ(52,RXIEN,7)
+ . ; Dispense unit is in the drug file, field 14.5
+ . S @MAP@("MEDQUANTITYUNIT")=$$GET1^DIQ(50,MEDIEN,14.5)
+ . ;
+ . ; --- START OF DIRECTIONS ---
+ . ; Sig data not in any API :-(  Oh yes, you can get the whole thing, but...
+ . ; we want the components.
+ . ; It's in multiple 113 in the Prescription File (52)
+ . ; #.01 DOSAGE ORDERED [1F]                   "20"
+ . ; #1 DISPENSE UNITS PER DOSE [2N]    "1"
+ . ; #2 UNITS [3P:50.607]                               "MG"
+ . ; #3 NOUN [4F]                                               "TABLET"
+ . ; #4 DURATION [5F]                                   "10D"
+ . ; #5 CONJUNCTION [6S]                                "AND"
+ . ; #6 ROUTE [7P:51.2]                                 "ORAL"
+ . ; #7 SCHEDULE [8F]                                   "BID"
+ . ; #8 VERB [9F]                                               "TAKE"
+ . ;
+ . ; Will use GETS^DIQ to get fields.
+ . ; Data comes out like this:
+ . ; SAMINS(52.0113,"1,23,",.01)=20
+ . ; SAMINS(52.0113,"1,23,",1)=1
+ . ; SAMINS(52.0113,"1,23,",2)="MG"
+ . ; SAMINS(52.0113,"1,23,",3)="TABLET"
+ . ; SAMINS(52.0113,"1,23,",4)="5D"
+ . ; SAMINS(52.0113,"1,23,",5)="THEN"
+ . ;
+ . N RAWDATA
+ . D GETS^DIQ(52,RXIEN,"113*",,"RAWDATA","DIERR")
+ . D:$D(DIERR) ^%ZTER  ; Log if there's an error in retrieving sig field
+ . ; none the less, continue; some parts are retrievable.
+ . N FMSIG M FMSIG=RAWDATA(52.0113) ; Merge into subfile...
+ . K RAWDATA
+ . N FMSIGNUM S FMSIGNUM="" ; Sigline number in fileman.
+ . ; FMSIGNUM gets outputted as "IEN,RXIEN,".
+ . ; DIRCNT is the proper Sigline numer.
+ . ; SIGDATA is the simplfied array. 
+ . F  S FMSIGNUM=$O(FMSIG(FMSIGNUM)) Q:FMSIGNUM=""  D
+ . . N DIRCNT S DIRCNT=$P(FMSIGNUM,",")
+ . . N SIGDATA M SIGDATA=FMSIG(FMSIGNUM)
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDIRECTIONDESCRIPTIONTEXT")=""  ; This is reserved for systems not able to generate the sig in components.
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDOSEINDICATOR")="1"  ; means that we are specifying it. See E2369-05.
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDELIVERYMETHOD")=$G(SIGDATA(8))
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDOSEVALUE")=$G(SIGDATA(.01))
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDOSEUNIT")=$G(SIGDATA(2))
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDRATEVALUE")=""  ; For inpatient
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDRATEUNIT")=""  ; For inpatient
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDVEHICLETEXT")=""  ; For inpatient
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDIRECTIONROUTETEXT")=$G(SIGDATA(6))
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDFREQUENCYVALUE")=$G(SIGDATA(7))
+ . . ; Invervals... again another call.
+ . . ; In the wisdom of the original programmers, the schedule is a free text field
+ . . ; However, it gets translated by a call to the administration schedule file
+ . . ; to see if that schedule exists.
+ . . ; That's the same thing I am going to do.
+ . . ; Search B index of 51.1 (Admin Schedule) with schedule
+ . . ; First, remove "PRN" if it exists (don't ask, that's how the file
+ . . ; works; I wouldn't do it that way).
+ . . N SCHNOPRN S SCHNOPRN=$G(SIGDATA(7))
+ . . I SCHNOPRN["PRN" S SCHNOPRN=$E(SCHNOPRN,1,$F(SCHNOPRN,"PRN")-5)
+ . . ; Super call below:
+ . . ; 1=File 51.1 3=Field 2 (Frequency in Minutes)
+ . . ; 4=Packed format, Exact Match 5=Lookup Value
+ . . ; 6=# of entries to return 7=Index 10=Return Array
+ . . ; 
+ . . ; I do not account for the fact that two schedules can be
+ . . ; spelled identically (ie duplicate entry). In that case,
+ . . ; I get the first. That's just a bad pharmacy pkg maintainer.
+ . . N C0C515
+ . . D FIND^DIC(51.1,,"@;2","PX",SCHNOPRN,1,"B",,,"C0C515")
+ . . N INTERVAL S INTERVAL="" ; Default
+ . . ; If there are entries found, get it
+ . . I +$G(C0C515("DILIST",0)) S INTERVAL=$P(C0C515("DILIST",1,0),U,2) 
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDINTERVALVALUE")=INTERVAL
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDINTERVALUNIT")="Minute"
+ . . ; Duration is 10M minutes, 10H hours, 10D for Days
+ . . ; 10W for weeks, 10L for months. I smell $Select
+ . . ; But we don't need to do that if there isn't a duration
+ . . I +$G(SIGDATA(4)) D
+ . . . N DURUNIT S DURUNIT=$E(SIGDATA(4),$L(SIGDATA(4))) ; get last char
+ . . . N DURTXT S DURTXT=$S(DURUNIT="M":"Minutes",DURUNIT="H":"Hours",DURUNIT="D":"Days",DURUNIT="W":"Weeks",DURUNIT="L":"Months",1:"Days")
+ . . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDURATIONVALUE")=+SIGDATA(4)
+ . . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDURATIONUNIT")=DURTXT
+ . . E  D
+ . . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDURATIONVALUE")=""
+ . . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDURATIONUNIT")=""
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPRNFLAG")=$G(SIGDATA(4))["PRN"
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMOBJECTID")="" ; when avail
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMTYPETXT")=""
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMDESCRIPTION")=""
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMCODEVALUE")=""
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMCODINGSYSTEM")=""
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMCODINGVERSION")=""
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMSOURCEACTORID")=""
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDSTOPINDICATOR")="" ; not stored
+ . . ; Another confusing line; I am pretty bad:
+ . . ; If there is another entry in the FMSIG array (i.e. another line
+ . . ; in the sig), set the direction count indicator.
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDIRSEQ")=""  ; Default
+ . . S:+$O(FMSIG(FMSIGNUM)) @MAP@("M","DIRECTIONS",DIRCNT,"MEDDIRSEQ")=DIRCNT
+ . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDMULDIRMOD")=$G(SIGDATA(5))
+ . ;
+ . ; --- END OF DIRECTIONS ---
+ . ;
+ . ; Med instructions is a WP field, thus the acrobatics
+ . ; Notice buffer overflow protection set at 10,000 chars
+ . ; -- 1. Med Patient Instructions
+ . N MEDPTIN1 S MEDPTIN1=$$GET1^DIQ(52,RXIEN,115,,"MEDPTIN1")
+ . N MEDPTIN2,J  S (MEDPTIN2,J)="" 
+ . I $L(MEDPTIN1) F  S J=$O(@MEDPTIN1@(J)) Q:J=""  Q:$L(MEDPTIN2)>10000  S MEDPTIN2=MEDPTIN2_@MEDPTIN1@(J)_" "
+ . S @MAP@("MEDPTINSTRUCTIONS")=MEDPTIN2
+ . K J
+ . ; -- 2. Med Provider Instructions
+ . N MEDPVIN1 S MEDPVIN1=$$GET1^DIQ(52,RXIEN,39,,"MEDPVIN1")
+ . N MEDPVIN2,J S (MEDPVIN2,J)=""
+ . I $L(MEDPVIN1) F  S J=$O(@MEDPVIN1@(J)) Q:J=""  Q:$L(MEDPVIN2)>10000  S MEDPVIN2=MEDPVIN2_@MEDPVIN1@(J)_" "
+ . S @MAP@("MEDFULLFILLMENTINSTRUCTIONS")=MEDPVIN2
+ . ;
+ . ; Remaining refills
+ . S @MAP@("MEDRFNO")=$P(MEDS(MEDCNT),U,6)
+ . ; ------ END OF MAPPING
+ . ;
+ . ; ------ BEGIN XML INSERTION
+ . N RESULT S RESULT=$NA(^TMP("C0CCCR",$J,"MAPPED"))
+ . K @RESULT
+ . D MAP^C0CXPATH(MINXML,MAP,RESULT)
+ . ; D PARY^C0CXPATH(RESULT)
+ . ; MAPPING DIRECTIONS
+ . N MEDDIR1,DIRXML1 S DIRXML1="MEDDIR1" ; VARIABLE AND NAME VARIABLE TEMPLATE
+ . N MEDDIR2,DIRXML2 S DIRXML2="MEDDIR2" ; VARIABLE AND NAME VARIABLE RESULT
+ . D QUERY^C0CXPATH(MINXML,"//Medications/Medication/Directions",DIRXML1)
+ . D REPLACE^C0CXPATH(RESULT,"","//Medications/Medication/Directions")
+ . ; N MDZ1,MDZNA
+ . N DIRCNT S DIRCNT=""
+ . I +$O(@MAP@("M","DIRECTIONS",DIRCNT)) D  ; IF THERE ARE DIRCTIONS
+ . . F DIRCNT=$O(@MAP@("M","DIRECTIONS",DIRCNT)) D  ; FOR EACH DIRECTION
+ . . . S MDZNA=$NA(@MAP@("M","DIRECTIONS",DIRCNT))
+ . . . D MAP^C0CXPATH(DIRXML1,MDZNA,DIRXML2)
+ . . . D INSERT^C0CXPATH(RESULT,DIRXML2,"//Medications/Medication")
+ . D:MEDCNT=1 CP^C0CXPATH(RESULT,OUTXML) ; First one is a copy
+ . D:MEDCNT>1 INSINNER^C0CXPATH(OUTXML,RESULT) ; AFTER THE FIRST, INSERT INNER XML
+ N MEDTMP,MEDI
+ D MISSING^C0CXPATH(OUTXML,"MEDTMP") ; SEARCH XML FOR MISSING VARS
+ I MEDTMP(0)>0 D  ; IF THERE ARE MISSING VARS - MARKED AS @@X@@
+ . W "MEDICATION MISSING ",!
+ . F MEDI=1:1:MEDTMP(0) W MEDTMP(MEDI),!
+ Q
+ ;
 GETRXN(NDC)     ; Extrinsic Function; PUBLIC; NDC to RxNorm
-        ;; Get RxNorm Concept Number for a Given NDC
-        ;
-        S NDC=$TR(NDC,"-")  ; Remove dashes
-        N RXNORM,C0CZRXN,DIERR
-        D FIND^DIC(176.002,,"@;.01","PX",NDC,"*","NDC",,,"C0CZRXN","DIERR")
-        I $D(DIERR) D ^%ZTER BREAK
-        S RXNORM(0)=+C0CZRXN("DILIST",0) ; RxNorm(0) will be # of entries
-        N I S I=0
-        F  S I=$O(C0CZRXN("DILIST",I)) Q:I=""  S RXNORM(I)=$P(C0CZRXN("DILIST",I,0),U,2)
-        ; At this point, RxNorm(0) is # of entries; RxNorm(1...) are the entries
-        ; If RxNorm(0) is 1, then we only have one entry, and that's it.
-        I RXNORM(0)=1 QUIT RXNORM(1)  ; RETURN RXNORM(1)
-        ; Otherwise, we need to find out which one is the semantic
-        ; clinical drug. I built an index on 176.001 (RxNorm Concepts)
-        ; for that purpose.
-        I RXNORM(0)>1 D
-        . S I=0
-        . F  S I=$O(RXNORM(I)) Q:I=""  D  Q:$G(RXNORM)
-        . . N RXNIEN S RXNIEN=$$FIND1^DIC(176.001,,,RXNORM(I),"SCD")
-        . . I +$G(RXNIEN)=0 QUIT  ; try the next entry... 
-        . . E  S RXNORM=RXNORM(I) QUIT  ; We found the right code
-        QUIT +$G(RXNORM)  ; RETURN RXNORM; if we couldn't find a clnical drug, return with 0
-        
+ ;; Get RxNorm Concept Number for a Given NDC
+ ;
+ S NDC=$TR(NDC,"-")  ; Remove dashes
+ N RXNORM,C0CZRXN,DIERR
+ D FIND^DIC(176.002,,"@;.01","PX",NDC,"*","NDC",,,"C0CZRXN","DIERR")
+ I $D(DIERR) D ^%ZTER BREAK
+ S RXNORM(0)=+C0CZRXN("DILIST",0) ; RxNorm(0) will be # of entries
+ N I S I=0
+ F  S I=$O(C0CZRXN("DILIST",I)) Q:I=""  S RXNORM(I)=$P(C0CZRXN("DILIST",I,0),U,2)
+ ; At this point, RxNorm(0) is # of entries; RxNorm(1...) are the entries
+ ; If RxNorm(0) is 1, then we only have one entry, and that's it.
+ I RXNORM(0)=1 QUIT RXNORM(1)  ; RETURN RXNORM(1)
+ ; Otherwise, we need to find out which one is the semantic
+ ; clinical drug. I built an index on 176.001 (RxNorm Concepts)
+ ; for that purpose.
+ I RXNORM(0)>1 D
+ . S I=0
+ . F  S I=$O(RXNORM(I)) Q:I=""  D  Q:$G(RXNORM)
+ . . N RXNIEN S RXNIEN=$$FIND1^DIC(176.001,,,RXNORM(I),"SCD")
+ . . I +$G(RXNIEN)=0 QUIT  ; try the next entry... 
+ . . E  S RXNORM=RXNORM(I) QUIT  ; We found the right code
+ QUIT +$G(RXNORM)  ; RETURN RXNORM; if we couldn't find a clnical drug, return with 0
+ 

ccr/trunk/p/C0CPARMS.m

@@ -1 +1 @@
 C0CPARMS        ; CCDCCR/GPL - CCR/CCD PARAMETER PROCESSING ; 1/29/09
- ;;0.3;CCDCCR;nopatch;noreleasedate
+ ;;1.0;C0C;;May 19, 2009;
  ;Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
  ;General Public License See attached copy of the License.

ccr/trunk/p/C0CPROBS.m

@@ -1 @@
-C0CPROBS ; CCDCCR/GPL - CCR/CCD PROCESSING FOR PROBLEMS ; 6/6/08
- ;;0.1;CCDCCR;nopatch;noreleasedate;Build 7
+C0CPROBS        ; CCDCCR/GPL - CCR/CCD PROCESSING FOR PROBLEMS ; 6/6/08
+ ;;1.0;C0C;;May 19, 2009;
  ;Copyright 2008,2009 George Lilly, University of Minnesota.
  ;Licensed under the terms of the GNU General Public License.
@@ -22 +22 @@
  ; PROCESS THE PROBLEMS SECTION OF THE CCR
  ;
-EXTRACT(IPXML,DFN,OUTXML) ; EXTRACT PROBLEMS INTO PROVIDED XML TEMPLATE
+EXTRACT(IPXML,DFN,OUTXML)       ; EXTRACT PROBLEMS INTO PROVIDED XML TEMPLATE
  ;
  ; INXML AND OUTXML ARE PASSED BY NAME SO GLOBALS CAN BE USED

ccr/trunk/p/C0CRIMA.m

@@ -1 @@
-C0CRIMA   ; CCDCCR/GPL - RIM REPORT ROUTINES; 6/6/08
- ;;0.1;CCDCCR;nopatch;noreleasedate
+C0CRIMA   ; CCDCCR/GPL - RIM REPORT ROUTINES; 6/6/08
+ ;;1.0;C0C;;May 19, 2009;
  ;Copyright 2008,2009 George Lilly, University of Minnesota.
  ;Licensed under the terms of the GNU General Public License.
@@ -37 +37 @@
  ;
  ;
-ANALYZE(BEGDFN,DFNCNT,APARMS) ; RIM COHERANCE ANALYSIS ROUTINE
+ANALYZE(BEGDFN,DFNCNT,APARMS)   ; RIM COHERANCE ANALYSIS ROUTINE
     ; BEGINS AT BEGDFN AND GOES FOR DFNCNT PATIENTS
     ; TO RESUME AT NEXT PATIENT, USE BEGDFN=""
@@ -108 +108 @@
     Q
     ;
-SETATTR(SDFN) ; SET ATTRIBUTES BASED ON VARS
+SETATTR(SDFN)   ; SET ATTRIBUTES BASED ON VARS
     N SBASE,SATTR
     S SBASE=$NA(@RIMBASE@("VARS",SDFN))
@@ -150 +150 @@
     Q SATTR
     ;
-RESET ; KILL RESUME INDICATOR TO START OVER. ALSO KILL RIM TMP VALUES
+RESET   ; KILL RESUME INDICATOR TO START OVER. ALSO KILL RIM TMP VALUES
     K ^TMP("C0CRIM","RESUME")
     K ^TMP("C0CRIM")
     Q
     ;
-CLIST ; LIST THE CATEGORIES
+CLIST   ; LIST THE CATEGORIES
     ;
     I '$D(RIMBASE) D ASETUP ; FOR COMMAND LINE CALLS
@@ -169 +169 @@
     Q
     ;
-CPUSH(CATRTN,CBASE,CTBL,CDFN,CATTR) ; ADD PATIENTS TO CATEGORIES
+CPUSH(CATRTN,CBASE,CTBL,CDFN,CATTR)     ; ADD PATIENTS TO CATEGORIES
     ; AND PASS BACK THE NAME OF THE CATEGORY TO WHICH THE PATIENT
     ; WAS ADDED IN CATRTN, WHICH IS PASSED BY REFERENCE
@@ -205 +205 @@
     Q
     ;
-CHKSUM(CKDFN) ; DOES A CHECKSUM AND STORES IT IN MUMPS GLOBALS
+CHKSUM(CKDFN)   ; DOES A CHECKSUM AND STORES IT IN MUMPS GLOBALS
  ; 
  S C0CCKB=$NA(^TMP("C0CRIM","CHKSUM")) ;CHECKSUM BASE
@@ -230 +230 @@
  Q CHKR
  ;
-CCOUNT ; RECOUNT THE CATEGORIES.. USE IN CASE OF RESTART OF ANALYZE
+CCOUNT  ; RECOUNT THE CATEGORIES.. USE IN CASE OF RESTART OF ANALYZE
     ;
     I '$D(RIMBASE) D ASETUP ; FOR COMMAND LINE CALLS
@@ -252 +252 @@
     Q
     ;
-CNTLST(INLST) ; RETURNS THE NUMBER OF ELEMENTS IN THE LIST
+CNTLST(INLST)   ; RETURNS THE NUMBER OF ELEMENTS IN THE LIST
     ; INLST IS PASSED BY NAME
     N ZI,ZDX,ZCOUNT
@@ -264 +264 @@
     Q ZCOUNT
     ;
-XCPAT(CPATCAT,CPATPARM) ; EXPORT TO FILE ALL PATIENTS IN CATEGORY CPATCAT
+XCPAT(CPATCAT,CPATPARM) ; EXPORT TO FILE ALL PATIENTS IN CATEGORY CPATCAT
     ;
     I '$D(CPATPARM) S CPATPARM=""
@@ -276 +276 @@
     Q
     ;
-CPAT(CPATCAT) ; SHOW PATIENT DFNS FOR A CATEGORY CPATCAT
+CPAT(CPATCAT)   ; SHOW PATIENT DFNS FOR A CATEGORY CPATCAT
     ;
     I '$D(RIMBASE) D ASETUP ; FOR COMMAND LINE CALLS
@@ -292 +292 @@
     Q
     ;
-PATC(DFN) ; DISPLAY THE CATEGORY FOR THIS PATIENT
+PATC(DFN)       ; DISPLAY THE CATEGORY FOR THIS PATIENT
     ;
     N ATTR S ATTR=""
@@ -305 +305 @@
     Q
     ;
-APUSH(AMAP,AVAL) ; ADD AVAL TO ATTRIBUTE MAP AMAP (AMAP PASSED BY NAME)
+APUSH(AMAP,AVAL)        ; ADD AVAL TO ATTRIBUTE MAP AMAP (AMAP PASSED BY NAME)
     ; AMAP IS FORMED FOR ARRAY ACCESS: AMAP(0) IS THE COUNT
     ; AND AMAP(N)=AVAL IS THE NTH AVAL
@@ -320 +320 @@
     Q
     ;
-ASETUP ; SET UP GLOBALS AND VARS RIMBASE AND RIMTBL
+ASETUP  ; SET UP GLOBALS AND VARS RIMBASE AND RIMTBL
       I '$D(RIMBASE) S RIMBASE=$NA(^TMP("C0CRIM"))
       I '$D(@RIMBASE) S @RIMBASE=""
@@ -327 +327 @@
       Q
       ;
-AINIT ; INITIALIZE ATTRIBUTE TABLE
+AINIT   ; INITIALIZE ATTRIBUTE TABLE
       I '$D(RIMBASE) D ASETUP ; FOR COMMAND LINE CALLS
       K @RIMTBL
@@ -358 +358 @@
       Q
       ;
-APOST(PRSLT,PTBL,PVAL) ; POST AN ATTRIBUTE PVAL TO PRSLT USING PTBL
+APOST(PRSLT,PTBL,PVAL)  ; POST AN ATTRIBUTE PVAL TO PRSLT USING PTBL
     ; PSRLT AND PTBL ARE PASSED BY NAME. PVAL IS A STRING
     ; PTBL IS THE NAME OF A TABLE IN @RIMBASE@("TABLES") - "RIMTBL"=ALL VALUES
@@ -369 +369 @@
     S $P(@PRSLT,U,@USETBL@(PVAL))=PVAL
     Q
-GETPA(RTN,DFN,ISEC,IVAR) ; RETURNS ARRAY OF RIM VARIABLES FOR PATIENT DFN
+GETPA(RTN,DFN,ISEC,IVAR)        ; RETURNS ARRAY OF RIM VARIABLES FOR PATIENT DFN
     ; EXAMPLE: D GETPA(.RT,2,"MEDS","MEDSSTATUSTEXT")
     ; RETURNS AN ARRAY RT OF VALUES OF MEDSTATUSTEXT FOR PATIENT 2 IN P2
@@ -392 +392 @@
     Q
     ;
-PATD(DFN,ISEC,IVAR) ; DISPLAY FOR PATIENT DFN THE VARIABLE IVAR
+PATD(DFN,ISEC,IVAR)     ; DISPLAY FOR PATIENT DFN THE VARIABLE IVAR
     ;
     N ZR
@@ -400 +400 @@
     Q
     ;
-CAGET(RTN,IATTR) ;
+CAGET(RTN,IATTR)        ;
     ; GETPA LOOKS AT RIMTBL TO FIND PATIENTS WITH ATTRIBUTE IATTR
     ; IT DOES NOT SEARCH ALL PATIENTS, ONLY THE ONES WITH THE ATTRIBUTE
@@ -406 +406 @@
     Q
     ;
-PCLST(LSTRTN,IATTR) ; RETURNS ARRAY OF PATIENTS WITH ATTRIBUTE IATTR
+PCLST(LSTRTN,IATTR)     ; RETURNS ARRAY OF PATIENTS WITH ATTRIBUTE IATTR
     ;
     I '$D(RIMBASE) D AINIT ; INITIALIZE GLOBAL NAMES AND TABLES
@@ -431 +431 @@
     Q
     ;
-DCPAT(CATTR) ; DISPLAY LIST OF PATIENTS WITH ATTRIBUTE CATTR
+DCPAT(CATTR)    ; DISPLAY LIST OF PATIENTS WITH ATTRIBUTE CATTR
     ;
     N ZR
@@ -442 +442 @@
     Q
     ;
-RPCGV(RTN,DFN,WHICH) ; RPC GET VARS
+RPCGV(RTN,DFN,WHICH)    ; RPC GET VARS
  ; RETURNS IN RTN (PASSED BY REFERENCE) THE VARS AND VALUES
  ; FOUND AT INARY RTN(X)="VAR^VALUE" RTN(0) IS THE COUNT
@@ -460 +460 @@
  Q
  ;
-ZGVWRK(ZWHICH) ; DO ONE SECTION FOR RPCGV
+ZGVWRK(ZWHICH)  ; DO ONE SECTION FOR RPCGV
     ;
     N ZZGN ; NAME FOR SECTION VARIABLES
@@ -477 +477 @@
     Q
     ;
-DPATV(DFN,IWHICH) ; DISPLAY VARS FOR PATIENT DFN THAT ARE MAINTAINED IN C0CRIM
+DPATV(DFN,IWHICH)       ; DISPLAY VARS FOR PATIENT DFN THAT ARE MAINTAINED IN C0CRIM
     ; ALONG WITH SAMPLE VALUES.
     ; IWHICH IS "ALL","MEDS","VITALS","PROBLEMS","ALERTS","RESULTS","HEADER"
@@ -488 +488 @@
     Q
     ;
-RIM2RNF(R2RTN,DFN,RWHICH) ; CONVERTS RIM VARIABLES TO RNF2 FORMAT
+RIM2RNF(R2RTN,DFN,RWHICH)       ; CONVERTS RIM VARIABLES TO RNF2 FORMAT
  ; RETURN IN R2RTN, WHICH IS PASSED BY NAME
  ; RWHICH IS RIM SECTION TO RETURN, DEFAULTS TO "ALL"
@@ -514 +514 @@
  Q
  ;
-RIM2CSV(DFN) ; WRITE THE RIM VARIABLES FOR A PATIENT TO A CSV FILE
+RIM2CSV(DFN)    ; WRITE THE RIM VARIABLES FOR A PATIENT TO A CSV FILE
  ;
  N R2CTMP,R2CARY

ccr/trunk/p/C0CRNF.m

@@ -1 @@
-C0CRNF   ; CCDCCR/GPL - Reference Name Format (RNF) utilities; 12/6/08
- ;;0.1;CCDCCR;nopatch;noreleasedate
+C0CRNF    ; CCDCCR/GPL - Reference Name Format (RNF) utilities; 12/6/08
+ ;;1.0;C0C;;May 19, 2009;
  ;Copyright 2009 George Lilly.  Licensed under the terms of the GNU
  ;General Public License See attached copy of the License.
@@ -22 +22 @@
  Q
  ;
-FIELDS(C0CFRTN,C0CF) ; RETURNS AN ARRAY OF THE FIELDS IN FILE C0CF,
+FIELDS(C0CFRTN,C0CF)    ; RETURNS AN ARRAY OF THE FIELDS IN FILE C0CF,
  ; C0CFRTN IS PASSED BY NAME, C0CF IS PASSED BY VALUE
  ;
@@ -44 +44 @@
  Q
  ;
-GETNOLD(GRTN,GFILE,GIEN,GNN) ; GET FIELDS FOR ACCESS BY NAME
+GETNOLD(GRTN,GFILE,GIEN,GNN)    ; GET FIELDS FOR ACCESS BY NAME
  ; GRTN IS PASSED BY NAME
  ;
@@ -70 +70 @@
  Q
  ;
-GETN(GRTN,GFILE,GREF,GNDX,GNN) ; GET BY NAME ; RETURN A FIELD VALUE MAP
+GETN(GRTN,GFILE,GREF,GNDX,GNN)  ; GET BY NAME ; RETURN A FIELD VALUE MAP
  ; THE FOLLOWING COMMENTS ARE WRONG.. THIS ROUTINE STILL RETURNS AN RNF1
  ; FORMAT ARRAY @GRTN@("FIELD NAME")="FILE^FIELD#^VALUE" ;GPL
@@ -134 +134 @@
  Q
  ;
-GETN1(GRTN,GFILE,GREF,GNDX,GNN) ; NEW GET ;GPL ; RETURN A FIELD VALUE MAP
+GETN1(GRTN,GFILE,GREF,GNDX,GNN) ; NEW GET ;GPL ; RETURN A FIELD VALUE MAP
  ; THE FOLLOWING COMMENTS ARE WRONG.. THIS ROUTINE STILL RETURNS AN RNF1
  ; FORMAT ARRAY @GRTN@("FIELD NAME")="FILE^FIELD#^VALUE" ;GPL
@@ -198 +198 @@
  Q
  ;
-GETN2(GARTN,GAFILE,GAIDX,GACNT,GASTRT,GANN) ; RETURN FIELD MAP AND VALUES
+GETN2(GARTN,GAFILE,GAIDX,GACNT,GASTRT,GANN)     ; RETURN FIELD MAP AND VALUES
  ; GARTN, PASSED BY NAME, RETURNS A FIELD MAP AND A VALUE MAP
  ; .. FIELD MAP @GARTN@("F","FIELDNAME")="FILE;FIELD#"
@@ -232 +232 @@
  Q
  ;
-ADDNV(GNV,GNVN,GNVF,GNVV) ; CREATE AN ELEMENT OF THE MATRIX
+ADDNV(GNV,GNVN,GNVF,GNVV)       ; CREATE AN ELEMENT OF THE MATRIX
  ;
  S @GNV@("F",GNVF)=$P(GNVV,"^",1)_"^"_$P(GNVV,"^",2) ;NAME=FILE^FIELD#
@@ -238 +238 @@
  Q
  ;
-RNF2CSV(RNRTN,RNIN,RNSTY) ;CONVERTS AN RFN2 GLOBAL TO A CSV FORMAT
+RNF2CSV(RNRTN,RNIN,RNSTY)       ;CONVERTS AN RFN2 GLOBAL TO A CSV FORMAT
  ; READY TO WRITE FOR USE WITH EXCEL @RNRTN@(0) IS NUMBER OF LINES
  ; RNSTY IS STYLE OF THE OUTPUT -
@@ -251 +251 @@
  Q
  ;
-NV(RNRTN,RNIN) ;
+NV(RNRTN,RNIN)  ;
  S RNR=$NA(@RNIN@("F"))
  S RNC=$NA(@RNIN@("V"))
@@ -273 +273 @@
  Q
  ;
-VN(RNRTN,RNIN) ;
+VN(RNRTN,RNIN)  ;
  S RNR=$NA(@RNIN@("V"))
  S RNC=$NA(@RNIN@("F"))
@@ -295 +295 @@
  Q
  ;
-FILE2CSV(FNUM,FVN) ; WRITES OUT A FILEMAN FILE TO CSV
+FILE2CSV(FNUM,FVN)      ; WRITES OUT A FILEMAN FILE TO CSV
  ;
  ;N G1,G2
@@ -308 +308 @@
  Q
  ;
-FILEOUT(FOARY,FONAM) ; WRITE OUT A FILE
+FILEOUT(FOARY,FONAM)    ; WRITE OUT A FILE
  ;
  W $$OUTPUT^GPLXPATH($NA(@FOARY@(1)),FONAM,^TMP("GPLCCR","ODIR"))
  Q
  ;
-FILEREF(FNUM) ; EXTRINSIC THAT RETURNS A CLOSED ROOT FOR FILE NUMBER FNUM
+FILEREF(FNUM)   ; EXTRINSIC THAT RETURNS A CLOSED ROOT FOR FILE NUMBER FNUM
  ;
  N C0CF
@@ -321 +321 @@
  Q C0CF
  ;
-SKIP ;
+SKIP    ;
  N TXT,DIERR
  S TXT=$$GET1^DIQ(8925,TIUIEN,"2","","TXT")
@@ -332 +332 @@
  Q
  ;
-ZFILE(ZFN,ZTAB) ; EXTRINSIC TO RETURN FILE NUMBER FOR FIELD NAME PASSED
+ZFILE(ZFN,ZTAB) ; EXTRINSIC TO RETURN FILE NUMBER FOR FIELD NAME PASSED
  ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 1 OF @ZTAB@(ZFN)
  ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA
  I '$D(ZTAB) S ZTAB="C0CA"
  Q $P(@ZTAB@(ZFN),"^",1)
-ZFIELD(ZFN,ZTAB) ;EXTRINSIC TO RETURN FIELD NUMBER FOR FIELD NAME PASSED
+ZFIELD(ZFN,ZTAB)        ;EXTRINSIC TO RETURN FIELD NUMBER FOR FIELD NAME PASSED
  ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 2 OF @ZTAB@(ZFN)
  ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA
  I '$D(ZTAB) S ZTAB="C0CA"
  Q $P(@ZTAB@(ZFN),"^",2)
-ZVALUE(ZFN,ZTAB) ;EXTRINSIC TO RETURN VALUE FOR FIELD NAME PASSED
+ZVALUE(ZFN,ZTAB)        ;EXTRINSIC TO RETURN VALUE FOR FIELD NAME PASSED
  ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 3 OF @ZTAB@(ZFN)
  ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA
@@ -348 +348 @@
  Q $P($G(@ZTAB@(ZFN)),"^",3)
  ;
-ZVALUEI(ZFN,ZTAB) ;EXTRINSIC TO RETURN INTERNAL VALUE FOR FIELD NAME PASSED
+ZVALUEI(ZFN,ZTAB)       ;EXTRINSIC TO RETURN INTERNAL VALUE FOR FIELD NAME PASSED
  ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 3 OF @ZTAB@(ZFN)
  ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA

ccr/trunk/p/C0CRXN.m

@@ -1 @@
-C0CRXN   ; CCDCCR/GPL - CCR RXN utilities; 12/6/08
- ;;0.1;CCDCCR;nopatch;noreleasedate
+C0CRXN    ; CCDCCR/GPL - CCR RXN utilities; 12/6/08
+ ;;1.0;C0C;;May 19, 2009;
  ;Copyright 2009 George Lilly.  Licensed under the terms of the GNU
  ;General Public License See attached copy of the License.
@@ -22 +22 @@
  Q
  ;
-EXPAND ; MAIN ROUTINE TO CREATE THE C0C RXNORM VUID EXPANSION FILE (176.112)
+EXPAND  ; MAIN ROUTINE TO CREATE THE C0C RXNORM VUID EXPANSION FILE (176.112)
  ; READ EACH RECORD FROM 176.111 AND USE THE VUID TO LOOK UP THE RXNORM
  ; CODE FROM 176.001 (RXNORM CONCEPTS)
@@ -83 +83 @@
  Q
  ;
-EXP2 ; ROUTINE TO CREATE 176.113 C0C RXNORM VUID MAPPING DISCREPANCIES FILE
+EXP2    ; ROUTINE TO CREATE 176.113 C0C RXNORM VUID MAPPING DISCREPANCIES FILE
  ; CROSS CHECKS THE NATIONAL DRUG FILE AND THE VA MAPPING FILE AGAINST
  ; THE UMLS RXNORM DATABASE
@@ -158 +158 @@
  W "NDF TEXT MISMATCH: ",NDFTCNT,!
  Q
-CHKNDF ; ROUTINE TO CHECK THE NATIONAL DRUG FILE WITH THE UMLS RXNORM DB
+CHKNDF  ; ROUTINE TO CHECK THE NATIONAL DRUG FILE WITH THE UMLS RXNORM DB
  ; USING THE AVUID INDEX, READS ALL VUID CODES IN ^PSNDF(50.68),
  ; CHECKS TO SEE IF THE CODE IS IN 176.001, AND CREATES A RECORD
@@ -253 +253 @@
  W "TEXT MATCHES:",TXTMATCH,!
  Q
-SETFDA(C0CSN,C0CSV) ; INTERNAL ROUTINE TO MAKE AN FDA ENTRY FOR FIELD C0CSN
+SETFDA(C0CSN,C0CSV)     ; INTERNAL ROUTINE TO MAKE AN FDA ENTRY FOR FIELD C0CSN
  ; TO SET TO VALUE C0CSV.
  ; C0CFDA,C0CA,C0CZX ARE ASSUMED FROM THE CALLING ROUTINE
@@ -263 +263 @@
  S C0CFDA(C0CSI,"+"_C0CZX_",",C0CSJ)=C0CSV
  Q
-ZFILE(ZFN,ZTAB) ; EXTRINSIC TO RETURN FILE NUMBER FOR FIELD NAME PASSED
+ZFILE(ZFN,ZTAB) ; EXTRINSIC TO RETURN FILE NUMBER FOR FIELD NAME PASSED
  ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 1 OF C0CA(ZFN)
  ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA
@@ -271 +271 @@
  E  S ZR=""
  Q ZR
-ZFIELD(ZFN,ZTAB) ;EXTRINSIC TO RETURN FIELD NUMBER FOR FIELD NAME PASSED
+ZFIELD(ZFN,ZTAB)        ;EXTRINSIC TO RETURN FIELD NUMBER FOR FIELD NAME PASSED
  ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 2 OF C0CA(ZFN)
  ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA
@@ -280 +280 @@
  Q ZR
  ;
-ZVALUE(ZFN,ZTAB) ;EXTRINSIC TO RETURN VALUE FOR FIELD NAME PASSED
+ZVALUE(ZFN,ZTAB)        ;EXTRINSIC TO RETURN VALUE FOR FIELD NAME PASSED
  ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 3 OF C0CA(ZFN)
  ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA

ccr/trunk/p/C0CSUB1.m

@@ -1 @@
-C0CSUB1   ; CCDCCR/GPL - CCR SUBSCRIPTION utilities; 12/6/08
- ;;0.1;CCDCCR;nopatch;noreleasedate
+C0CSUB1   ; CCDCCR/GPL - CCR SUBSCRIPTION utilities; 12/6/08
+ ;;1.0;C0C;;May 19, 2009;
  ;Copyright 2009 George Lilly.  Licensed under the terms of the GNU
  ;General Public License See attached copy of the License.
@@ -21 +21 @@
  Q
  ;
-CHK1(DFN) ; ADD THE CHECKSUM FOR ONE PATIENT
+CHK1(DFN)       ; ADD THE CHECKSUM FOR ONE PATIENT
  ;
  S C0CCHK=$NA(^TMP("C0CRIM","CHKSUM"))
@@ -43 +43 @@
  Q
  ;
-SUBALL ; SUBSCRIBE ALL PATIENTS IN CCR GLOBALS TO SUBCRIBER 1
+SUBALL  ; SUBSCRIBE ALL PATIENTS IN CCR GLOBALS TO SUBCRIBER 1
  ;
  S C0CGLB=$NA(^TMP("C0CRIM","VARS"))
@@ -51 +51 @@
  Q
  ;
-SUB1(DFN,C0CSS) ; SUBSCRIBE ONE PATIENT TO SUBSCRIBER C0CSS
+SUB1(DFN,C0CSS) ; SUBSCRIBE ONE PATIENT TO SUBSCRIBER C0CSS
  ;
  S C0CSF=177.101 ; FILE NUMBER FOR SUBSCRIPTION FILE
@@ -66 +66 @@
  Q
  ;
-UPDIE ; INTERNAL ROUTINE TO CALL UPDATE^DIE AND CHECK FOR ERRORS
+UPDIE   ; INTERNAL ROUTINE TO CALL UPDATE^DIE AND CHECK FOR ERRORS
  K ZERR
  D CLEAN^DILF
@@ -77 +77 @@
  Q
  ;
-VARPTR(ZVAR,ZTYP) ;EXTRINSIC WHICH RETURNS THE POINTER TO ZVAR IN THE
+VARPTR(ZVAR,ZTYP)       ;EXTRINSIC WHICH RETURNS THE POINTER TO ZVAR IN THE
  ; CCR DICTIONARY. IT IS LAYGO, AS IT WILL ADD THE VARIABLE TO
  ; THE CCR DICTIONARY IF IT IS NOT THERE. ZTYP IS REQUIRED FOR LAYGO
@@ -99 +99 @@
  Q ZVARN
  ;
-SETFDA(C0CSN,C0CSV) ; INTERNAL ROUTINE TO MAKE AN FDA ENTRY FOR FIELD C0CSN
+SETFDA(C0CSN,C0CSV)     ; INTERNAL ROUTINE TO MAKE AN FDA ENTRY FOR FIELD C0CSN
  ; TO SET TO VALUE C0CSV.
  ; C0CFDA,C0CC,C0CZX ARE ASSUMED FROM THE CALLING ROUTINE
@@ -109 +109 @@
  S C0CFDA(C0CSI,C0CZX_",",C0CSJ)=C0CSV
  Q
-ZFILE(ZFN,ZTAB) ; EXTRINSIC TO RETURN FILE NUMBER FOR FIELD NAME PASSED
+ZFILE(ZFN,ZTAB) ; EXTRINSIC TO RETURN FILE NUMBER FOR FIELD NAME PASSED
  ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 1 OF C0CA(ZFN)
  ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA
@@ -117 +117 @@
  E  S ZR=""
  Q ZR
-ZFIELD(ZFN,ZTAB) ;EXTRINSIC TO RETURN FIELD NUMBER FOR FIELD NAME PASSED
+ZFIELD(ZFN,ZTAB)        ;EXTRINSIC TO RETURN FIELD NUMBER FOR FIELD NAME PASSED
  ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 2 OF C0CA(ZFN)
  ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA
@@ -126 +126 @@
  Q ZR
  ;
-ZVALUE(ZFN,ZTAB) ;EXTRINSIC TO RETURN VALUE FOR FIELD NAME PASSED
+ZVALUE(ZFN,ZTAB)        ;EXTRINSIC TO RETURN VALUE FOR FIELD NAME PASSED
  ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 3 OF C0CA(ZFN)
  ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA

ccr/trunk/p/C0CSYS.m

@@ -1 @@
-C0CSYS ;WV/C0C/SMH - Routine to Get EHR System Information;6JUL2008
- ;;0.1;C0C;;;
+C0CSYS  ;WV/C0C/SMH - Routine to Get EHR System Information;6JUL2008
+ ;;1.0;C0C;;May 19, 2009;
  ; Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
  ; General Public License See attached copy of the License.
@@ -27 +27 @@
  ; So for now, I am hard-coding the values.
  ;
-SYSNAME() ;Get EHR System Name; PUBLIC; Extrinsic
-                Q:$G(DUZ("AG"))="I" "RPMS"
-        Q "WorldVistA EHR/VOE"
-        ;
-SYSVER() ;Get EHR System Version; PUBLIC; Extrinsic
-        Q "1.0"
-        ;
-PTST(DFN) ;TEST TO SEE IF PATIENT MERGED OR A TEST PATIENT
-         ; DFN = IEN of the Patient to be tested
-         ; 1 = Merged or Test Patient
-         ; 0 = Non-test Patient
-         ;
-         I DFN="" Q 0  ; BAD DFN PASSED
-         I $D(^DPT(DFN,-9)) Q 1  ;This patient has been merged
-         I $G(^DPT(DFN,0))="" Q 1  ;Missing zeroth node <---add
-         ;
-         I '$D(CCRTEST) S CCRTEST=1 ; DEFAULT IS THAT WE ARE TESTING
-         I CCRTEST Q 0  ; IF WE ARE TESTING, DON'T REJECT TEST PATIENTS
-         N DIERR,DATA
-         I $$TESTPAT^VADPT(DFN) Q 1 ; QUIT IF IT'S A VA TEST PATIENT
-         S DATA=+$$GET1^DIQ(2,DFN_",",.6,"I") ;Test Patient Indicator
-         ; 1 = Test Patient
-         ; 0 = Non-test Patient
-         I DATA Q DATA
-         S DATA=$$GET1^DIQ(2,DFN_",",.09,"I") ;SSN test
-         D CLEAN^DILF
-         I "Pp"[$E(DATA,$L(DATA),$L(DATA)) Q 0  ;Allow Pseudo SSN
-         I $E(DATA,1,3)="000" Q 1
-         I $E(DATA,1,3)="666" Q 1
-         Q 0
-         ;
+SYSNAME()       ;Get EHR System Name; PUBLIC; Extrinsic
+ Q:$G(DUZ("AG"))="I" "RPMS"
+ Q "WorldVistA EHR/VOE"
+ ;
+SYSVER()        ;Get EHR System Version; PUBLIC; Extrinsic
+ Q "1.0"
+ ;
+PTST(DFN)       ;TEST TO SEE IF PATIENT MERGED OR A TEST PATIENT
+  ; DFN = IEN of the Patient to be tested
+  ; 1 = Merged or Test Patient
+  ; 0 = Non-test Patient
+  ;
+  I DFN="" Q 0  ; BAD DFN PASSED
+  I $D(^DPT(DFN,-9)) Q 1  ;This patient has been merged
+  I $G(^DPT(DFN,0))="" Q 1  ;Missing zeroth node <---add
+  ;
+  I '$D(CCRTEST) S CCRTEST=1 ; DEFAULT IS THAT WE ARE TESTING
+  I CCRTEST Q 0  ; IF WE ARE TESTING, DON'T REJECT TEST PATIENTS
+  N DIERR,DATA
+  I $$TESTPAT^VADPT(DFN) Q 1 ; QUIT IF IT'S A VA TEST PATIENT
+  S DATA=+$$GET1^DIQ(2,DFN_",",.6,"I") ;Test Patient Indicator
+  ; 1 = Test Patient
+  ; 0 = Non-test Patient
+  I DATA Q DATA
+  S DATA=$$GET1^DIQ(2,DFN_",",.09,"I") ;SSN test
+  D CLEAN^DILF
+  I "Pp"[$E(DATA,$L(DATA),$L(DATA)) Q 0  ;Allow Pseudo SSN
+  I $E(DATA,1,3)="000" Q 1
+  I $E(DATA,1,3)="666" Q 1
+  Q 0
+  ;

ccr/trunk/p/C0CUNIT.m

@@ -1 @@
-C0CUNIT ; CCDCCR/GPL - Unit Testing Library; 5/07/08
- ;;0.1;CCDCCR;nopatch;noreleasedate
+C0CUNIT ; CCDCCR/GPL - Unit Testing Library; 5/07/08
+ ;;1.0;C0C;;May 19, 2009;
  ;Copyright 2008 George Lilly. Licensed under the terms of the GNU
  ;General Public License See attached copy of the License.
@@ -22 +22 @@
           Q
           ;
-ZT(ZARY,BAT,TST) ; private routine to add a test case to the ZARY array
+ZT(ZARY,BAT,TST)        ; private routine to add a test case to the ZARY array
           ; ZARY IS PASSED BY REFERENCE
           ; BAT is a string identifying the test battery
@@ -45 +45 @@
           Q
           ;
-ZLOAD(ZARY,ROUTINE)  ; load tests into ZARY which is passed by reference
+ZLOAD(ZARY,ROUTINE)      ; load tests into ZARY which is passed by reference
           ; ZARY IS PASSED BY NAME
           ; ZARY = name of the root, closed array format (e.g., "^TMP($J)")
@@ -68 +68 @@
           Q
           ;
-ZTEST(ZARY,WHICH)   ; try out the tests using a passed array ZTEST
+ZTEST(ZARY,WHICH)         ; try out the tests using a passed array ZTEST
           N ZI,ZX,ZR,ZP
           S DEBUG=0
@@ -104 +104 @@
           Q
           ;
-TEST   ; RUN ALL THE TEST CASES
+TEST      ; RUN ALL THE TEST CASES
           N ZTMP
           D ZLOAD(.ZTMP)
@@ -115 +115 @@
           Q
           ;
-GTSTS(GTZARY,RTN) ; return an array of test names
+GTSTS(GTZARY,RTN)       ; return an array of test names
           N I,J S I="" S I=$O(GTZARY("TESTS",I))
           F J=0:0  Q:I=""  D
@@ -122 +122 @@
           Q
           ;
-TESTALL(RNM) ; RUN ALL THE TESTS
+TESTALL(RNM)    ; RUN ALL THE TESTS
           N ZI,J,TZTMP,TSTS,TOTP,TOTF
           S TOTP=0 S TOTF=0
@@ -141 +141 @@
           Q
           ;
-TLIST(ZARY) ; LIST ALL THE TESTS
+TLIST(ZARY)     ; LIST ALL THE TESTS
           ; THEY ARE MARKED AS ;;><TESTNAME> IN THE TEST CASES
           ; ZARY IS PASSED BY REFERENCE
@@ -155 +155 @@
           Q
           ;
-MEDS
+MEDS    
  N DEBUG S DEBUG=0
  N DFN S DFN=5685
@@ -172 +172 @@
  D FILEOUT^C0CRNF(OUTXML,"TESTMEDS.xml")
  Q
-PAT
+PAT     
  D ANALYZE^ARJTXRD("C0CDPT",.OUT) ; Analyze a routine in the directory
  N X,Y

ccr/trunk/p/C0CUTIL.m

@@ -1 +1 @@
 C0CUTIL ;WV/C0C/SMH - Various Utilites for generating the CCR/CCD;06/15/08
-        ;;0.1;C0C;;Jun 15, 2008;
-        ;Copyright 2008-2009 Sam Habiel & George Lilly.  
-        ;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 at Top!"
-        Q
-        ;
+ ;;1.0;C0C;;May 19, 2009;
+ ;Copyright 2008-2009 Sam Habiel & George Lilly.  
+ ;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 at Top!"
+ Q
+ ;
 FMDTOUTC(DATE,FORMAT)   ; Convert Fileman Date to UTC Date Format; PUBLIC; Extrinsic
-        ; FORMAT is Format of Date. Can be either D (Day) or DT (Date and Time)
-        ; If not passed, or passed incorrectly, it's assumed that it is D.
-        ; FM Date format is "YYYMMDD.HHMMSS" HHMMSS may not be supplied.
-        ; UTC date is formatted as follows: YYYY-MM-DDThh:mm:ss_offsetfromUTC
-        ; UTC, Year, Month, Day, Hours, Minutes, Seconds, Time offset (obtained from Mailman Site Parameters)
-        N UTC,Y,M,D,H,MM,S,OFF
-        S Y=1700+$E(DATE,1,3)
-        S M=$E(DATE,4,5)
-        S D=$E(DATE,6,7)
-        S H=$E(DATE,9,10)
-        I $L(H)=1 S H="0"_H
-        S MM=$E(DATE,11,12)
-        I $L(MM)=1 S MM="0"_MM
-        S S=$E(DATE,13,14)
-        I $L(S)=1 S S="0"_S
-        S OFF=$$TZ^XLFDT ; See Kernel Manual for documentation.
-        S OFFS=$E(OFF,1,1)
-        S OFF0=$TR(OFF,"+-")
-        S OFF1=$E(OFF0+10000,2,3)
-        S OFF2=$E(OFF0+10000,4,5)
-        S OFF=OFFS_OFF1_":"_OFF2
-        ;S OFF2=$E(OFF,1,2) ;
-        ;S OFF2=$E(100+OFF2,2,3) ; GPL 11/08 CHANGED TO -05:00 FORMAT
-        ;S OFF3=$E(OFF,3,4) ;MINUTES
-        ;S OFF=$S(OFF2="":"00",0:"00",1:OFF2)_"."_$S(OFF3="":"00",1:OFF3)
-        ; If H, MM and S are empty, it means that the FM date didn't supply the time.
-        ; In this case, set H, MM and S to "00"
-        ; S:('$L(H)&'$L(MM)&'$L(S)) (H,MM,S)="00" ; IF ONLY SOME ARE MISSING?
-        S:'$L(H) H="00"
-        S:'$L(MM) MM="00"
-        S:'$L(S) S="00"
-        S UTC=Y_"-"_M_"-"_D_"T"_H_":"_MM_$S(S="":":00",1:":"_S)_OFF ; Skip's code to fix hanging colon if no seconds
-        I $L($G(FORMAT)),FORMAT="DT" Q UTC ; Date with time.
-        E  Q $P(UTC,"T")
-        ;
+ ; FORMAT is Format of Date. Can be either D (Day) or DT (Date and Time)
+ ; If not passed, or passed incorrectly, it's assumed that it is D.
+ ; FM Date format is "YYYMMDD.HHMMSS" HHMMSS may not be supplied.
+ ; UTC date is formatted as follows: YYYY-MM-DDThh:mm:ss_offsetfromUTC
+ ; UTC, Year, Month, Day, Hours, Minutes, Seconds, Time offset (obtained from Mailman Site Parameters)
+ N UTC,Y,M,D,H,MM,S,OFF
+ S Y=1700+$E(DATE,1,3)
+ S M=$E(DATE,4,5)
+ S D=$E(DATE,6,7)
+ S H=$E(DATE,9,10)
+ I $L(H)=1 S H="0"_H
+ S MM=$E(DATE,11,12)
+ I $L(MM)=1 S MM="0"_MM
+ S S=$E(DATE,13,14)
+ I $L(S)=1 S S="0"_S
+ S OFF=$$TZ^XLFDT ; See Kernel Manual for documentation.
+ S OFFS=$E(OFF,1,1)
+ S OFF0=$TR(OFF,"+-")
+ S OFF1=$E(OFF0+10000,2,3)
+ S OFF2=$E(OFF0+10000,4,5)
+ S OFF=OFFS_OFF1_":"_OFF2
+ ;S OFF2=$E(OFF,1,2) ;
+ ;S OFF2=$E(100+OFF2,2,3) ; GPL 11/08 CHANGED TO -05:00 FORMAT
+ ;S OFF3=$E(OFF,3,4) ;MINUTES
+ ;S OFF=$S(OFF2="":"00",0:"00",1:OFF2)_"."_$S(OFF3="":"00",1:OFF3)
+ ; If H, MM and S are empty, it means that the FM date didn't supply the time.
+ ; In this case, set H, MM and S to "00"
+ ; S:('$L(H)&'$L(MM)&'$L(S)) (H,MM,S)="00" ; IF ONLY SOME ARE MISSING?
+ S:'$L(H) H="00"
+ S:'$L(MM) MM="00"
+ S:'$L(S) S="00"
+ S UTC=Y_"-"_M_"-"_D_"T"_H_":"_MM_$S(S="":":00",1:":"_S)_OFF ; Skip's code to fix hanging colon if no seconds
+ I $L($G(FORMAT)),FORMAT="DT" Q UTC ; Date with time.
+ E  Q $P(UTC,"T")
+ ;
 SORTDT(V1,V2,ORDR)      ; DATE SORT ARRAY AND RETURN INDEX IN V1 AND COUNT
-        ; AS EXTRINSIC ORDR IS 1 OR -1 FOR FORWARD OR REVERSE
-        ; DATE AND TIME ORDER. DEFAULT IS FORWARD
-        ; V2 IS AN ARRAY OF DATES IN FILEMAN FORMAT
-        ; V1 IS RETURNS INDIRECT INDEXES OF V2 IN REVERSE DATE ORDER
-        ; SO V2(V1(X)) WILL RETURN THE DATES IN DATE/TIME ORDER
-        ; THE COUNT OF THE DATES IS RETURNED AS AN EXTRINSIC
-        ; BOTH V1 AND V2 ARE PASSED BY REFERENCE
-        N VSRT ; TEMP FOR HASHING DATES
-        N ZI,ZJ,ZTMP,ZCNT,ZP1,ZP2
-        S ZCNT=V2(0) ; COUNTING NUMBER OF DATES
-        F ZI=1:1:ZCNT D  ; FOR EACH DATE IN THE ARRAY
-        . I $D(V2(ZI)) D  ; IF THE DATE EXISTS
-        . . S ZP1=$P(V2(ZI),".",1) ; THE DATE PIECE
-        . . S ZP2=$P(V2(ZI),".",2) ; THE TIME PIECE
-        . . ; W "DATE: ",ZP1," TIME: ",ZP2,!
-        . . S VSRT(ZP1,ZP2,ZI)=ZI ; INDEX OF DATE, TIME AND COUNT
-        N ZG
-        S ZG=$Q(VSRT(""))
-        F  D  Q:ZG=""  ;
-        . ; W ZG,!
-        . D PUSH^GPLXPATH("V1",@ZG)
-        . S ZG=$Q(@ZG)
-        I ORDR=-1 D  ; HAVE TO REVERSE ORDER
-        . N ZG2
-        . F ZI=1:1:V1(0) D  ; FOR EACH ELELMENT
-        . . S ZG2(V1(0)-ZI+1)=V1(ZI) ; SET IN REVERSE ORDER
-        . S ZG2(0)=V1(0)
-        . D CP^GPLXPATH("ZG2","V1") ; COPY OVER THE NEW ARRAY
-        Q ZCNT
-        ;
+ ; AS EXTRINSIC ORDR IS 1 OR -1 FOR FORWARD OR REVERSE
+ ; DATE AND TIME ORDER. DEFAULT IS FORWARD
+ ; V2 IS AN ARRAY OF DATES IN FILEMAN FORMAT
+ ; V1 IS RETURNS INDIRECT INDEXES OF V2 IN REVERSE DATE ORDER
+ ; SO V2(V1(X)) WILL RETURN THE DATES IN DATE/TIME ORDER
+ ; THE COUNT OF THE DATES IS RETURNED AS AN EXTRINSIC
+ ; BOTH V1 AND V2 ARE PASSED BY REFERENCE
+ N VSRT ; TEMP FOR HASHING DATES
+ N ZI,ZJ,ZTMP,ZCNT,ZP1,ZP2
+ S ZCNT=V2(0) ; COUNTING NUMBER OF DATES
+ F ZI=1:1:ZCNT D  ; FOR EACH DATE IN THE ARRAY
+ . I $D(V2(ZI)) D  ; IF THE DATE EXISTS
+ . . S ZP1=$P(V2(ZI),".",1) ; THE DATE PIECE
+ . . S ZP2=$P(V2(ZI),".",2) ; THE TIME PIECE
+ . . ; W "DATE: ",ZP1," TIME: ",ZP2,!
+ . . S VSRT(ZP1,ZP2,ZI)=ZI ; INDEX OF DATE, TIME AND COUNT
+ N ZG
+ S ZG=$Q(VSRT(""))
+ F  D  Q:ZG=""  ;
+ . ; W ZG,!
+ . D PUSH^GPLXPATH("V1",@ZG)
+ . S ZG=$Q(@ZG)
+ I ORDR=-1 D  ; HAVE TO REVERSE ORDER
+ . N ZG2
+ . F ZI=1:1:V1(0) D  ; FOR EACH ELELMENT
+ . . S ZG2(V1(0)-ZI+1)=V1(ZI) ; SET IN REVERSE ORDER
+ . S ZG2(0)=V1(0)
+ . D CP^GPLXPATH("ZG2","V1") ; COPY OVER THE NEW ARRAY
+ Q ZCNT
+ ;
 DA2SNO(RTN,DNAME)       ; LOOK UP DRUG ALLERGY CODE IN ^LEX
-        ; RETURNS AN ARRAY RTN PASSED BY REFERENCE
-        ; THIS ROUTINE CAN BE USED AS AN RPC
-        ; RTN(0) IS THE NUMBER OF ELEMENTS IN THE ARRAY
-        ; RTN(1) IS THE SNOMED CODE FOR THE DRUG ALLERGY
-        ;
-        N LEXIEN
-        I $O(^LEX(757.21,"ADIS",DNAME,""))'="" D  ; IEN FOUND FOR THIS DRUG
-        . S LEXIEN=$O(^LEX(757.21,"ADIS",DNAME,"")) ; GET THE IEN IN THE LEXICON
-        . W LEXIEN,!
-        . S RTN(1)=$P(^LEX(757.02,LEXIEN,0),"^",2) ; SNOMED CODE IN P2
-        . S RTN(0)=1 ; ONE THING RETURNED
-        E  S RTN(0)=0 ; NOT FOUND
-        Q
-        ;
+ ; RETURNS AN ARRAY RTN PASSED BY REFERENCE
+ ; THIS ROUTINE CAN BE USED AS AN RPC
+ ; RTN(0) IS THE NUMBER OF ELEMENTS IN THE ARRAY
+ ; RTN(1) IS THE SNOMED CODE FOR THE DRUG ALLERGY
+ ;
+ N LEXIEN
+ I $O(^LEX(757.21,"ADIS",DNAME,""))'="" D  ; IEN FOUND FOR THIS DRUG
+ . S LEXIEN=$O(^LEX(757.21,"ADIS",DNAME,"")) ; GET THE IEN IN THE LEXICON
+ . W LEXIEN,!
+ . S RTN(1)=$P(^LEX(757.02,LEXIEN,0),"^",2) ; SNOMED CODE IN P2
+ . S RTN(0)=1 ; ONE THING RETURNED
+ E  S RTN(0)=0 ; NOT FOUND
+ Q
+ ;
 DASNO(DANAME)   ; PRINTS THE SNOMED CODE FOR ALLERGY TO DRUG DANAME
-        ;
-        N DARTN
-        D DA2SNO(.DARTN,DANAME) ; CALL THE LOOKUP ROUTINE
-        I DARTN(0)>0 D  ; GOT RESULTS
-        . W !,DARTN(1) ;PRINT THE SNOMED CODE
-        E  W !,"NOT FOUND",!
-        Q
-        ;
+ ;
+ N DARTN
+ D DA2SNO(.DARTN,DANAME) ; CALL THE LOOKUP ROUTINE
+ I DARTN(0)>0 D  ; GOT RESULTS
+ . W !,DARTN(1) ;PRINT THE SNOMED CODE
+ E  W !,"NOT FOUND",!
+ Q
+ ;
 DASNALL(WHICH)  ; ROUTINE TO EXAMINE THE ADIS INDEX IN LEX AND RETRIEVE ALL
-        ; ASSOCIATED SNOMED CODES
-        N DASTMP,DASIEN,DASNO
-        S DASTMP=""
-        F  S DASTMP=$O(^LEX(757.21,WHICH,DASTMP)) Q:DASTMP=""  D  ; NAME OF MED
-        . S DASIEN=$O(^LEX(757.21,WHICH,DASTMP,"")) ; IEN OF MED
-        . S DASNO=$P(^LEX(757.02,DASIEN,0),"^",2) ; SNOMED CODE FOR ENTRY
-        . W DASTMP,"=",DASNO,! ; PRINT IT OUT
-        Q
-        ;
+ ; ASSOCIATED SNOMED CODES
+ N DASTMP,DASIEN,DASNO
+ S DASTMP=""
+ F  S DASTMP=$O(^LEX(757.21,WHICH,DASTMP)) Q:DASTMP=""  D  ; NAME OF MED
+ . S DASIEN=$O(^LEX(757.21,WHICH,DASTMP,"")) ; IEN OF MED
+ . S DASNO=$P(^LEX(757.02,DASIEN,0),"^",2) ; SNOMED CODE FOR ENTRY
+ . W DASTMP,"=",DASNO,! ; PRINT IT OUT
+ Q
+ ;
 RPMS()  ; Are we running on an RPMS system rather than Vista?
-        Q $G(DUZ("AG"))="I" ; If User Agency is Indian Health Service
+ Q $G(DUZ("AG"))="I" ; If User Agency is Indian Health Service
 VISTA() ; Are we running on Vanilla Vista?
-        Q $G(DUZ("AG"))="V" ; If User Agency is VA
+ Q $G(DUZ("AG"))="V" ; If User Agency is VA
 WV()    ; Are we running on WorldVista? 
-        Q $G(DUZ("AG"))="E" ; Code for WV.
+ Q $G(DUZ("AG"))="E" ; Code for WV.
 OV()    ; Are we running on OpenVista?
-        Q $G(DUZ("AG"))="O" ; Code for OpenVista
+ Q $G(DUZ("AG"))="O" ; Code for OpenVista

ccr/trunk/p/C0CVA200.m

@@ -1 @@
-C0CVA200 ;WV/C0C/SMH - Routine to get Provider Data;07/13/2008
-        ;;0.1;C0C;;JUL 13, 2007;Build 0
+C0CVA200        ;WV/C0C/SMH - Routine to get Provider Data;07/13/2008
+ ;;1.0;C0C;;May 19, 2009;
  ;Copyright 2008 Sam Habiel.  Licensed under the terms of the GNU
  ;General Public License See attached copy of the License.
@@ -17 +17 @@
  ;with this program; if not, write to the Free Software Foundation, Inc.,
  ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
-        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
-        N NAME S NAME=$P(^VA(200,DUZ,0),U)
-        D NAMECOMP^XLFNAME(.NAME)
-        Q NAME("FAMILY")
-        ;
-GIVEN(DUZ) ; Get Given Name; PUBLIC; EXTRINSIC
-        ; INPUT: DUZ ByVal
-        ; OUTPUT: String
-        N NAME S NAME=$P(^VA(200,DUZ,0),U)
-        D NAMECOMP^XLFNAME(.NAME)
-        Q NAME("GIVEN")
-        ;
-MIDDLE(DUZ) ; Get Middle Name, PUBLIC; EXTRINSIC
-        ; INPUT: DUZ ByVal
-        ; OUTPUT: String
-        N NAME S NAME=$P(^VA(200,DUZ,0),U)
-        D NAMECOMP^XLFNAME(.NAME)
-        Q NAME("MIDDLE")
-        ;
-SUFFIX(DUZ) ; Get Suffix Name, PUBLIC; EXTRINSIC
-        ; INPUT: DUZ ByVal
-        ; OUTPUT: String
-        N NAME S NAME=$P(^VA(200,DUZ,0),U)
-        D NAMECOMP^XLFNAME(.NAME)
-        Q NAME("SUFFIX")
-        ;
-TITLE(DUZ) ; Get Title for Proivder, PUBLIC; EXTRINSIC
-        ; INPUT: DUZ ByVal
-        ; OUTPUT: String
-        ; Gets External Value of Title field in New Person File.
-        ; It's actually a pointer to file 3.1
-        ; 200=New Person File; 8 is Title Field
-        Q $$GET1^DIQ(200,DUZ_",",8)
-        ;
-NPI(DUZ) ; Get NPI Number, PUBLIC; EXTRINSIC
-        ; INPUT: DUZ ByVal
-        ; OUTPUT: Delimited String in format:
-        ;       IDType^ID^IDDescription
-        ; If the NPI doesn't exist, "" is returned.
-        ; This routine uses a call documented in the Kernel dev guide
-        ; This call returns as "NPI^TimeEntered^ActiveInactive"
-        ; It returns -1 for NPI if NPI doesn't exist.
-        N NPI S NPI=$P($$NPI^XUSNPI("Individual_ID",DUZ),U)
-        Q:NPI=-1 ""
-        Q "NPI^"_NPI_"^HHS"
-        ;
-SPEC(DUZ) ; Get Provider Specialty, PUBLIC; EXTRINSIC
-        ; INPUT: DUZ ByVal
-        ; 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
-        N STR S STR=$$GET^XUA4A72(DUZ)
-        Q:+STR<0 ""
-        ; Sometimes we have 3 pieces, or 2. Deal with that.
-        Q:$L($P(STR,U,4)) $P(STR,U,2)_"-"_$P(STR,U,3)_"-"_$P(STR,U,4)
-        Q $P(STR,U,2)_"-"_$P(STR,U,3)
-        ;
-ADDTYPE(DUZ) ; Get Address Type, PUBLIC; EXTRINSIC
-        ; INPUT: DUZ, but not needed really... here for future expansion
-        ; OUTPUT: At this point "Work"
-        Q "Work"
-        ;
-ADDLINE1(ADUZ) ; Get Address associated with this instituation; PUBLIC; EXTRINSIC ; CHANGED PARAMETER TO ADUZ TO KEEP FROM CRASHING GPL 1/09
-        ; 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
-        ; one we want to use; then check for physical. If neither exists,
-        ; then we return nothing. We check for the existence of an address
-        ; by the length of the returned string.
-        ; NOTE: API doesn't support Address 2, so I won't even include it
-        ; in the template.
-        N ADD
-        S ADD=$$MADD^XUAF4(INST) ; mailing address
-        Q:$L(ADD) $P(ADD,U)
-        S ADD=$$PADD^XUAF4(INST) ; physical address
-        Q:$L(ADD) $P(ADD,U)
-        Q ""
-        ;
-CITY(ADUZ) ; Get City for Institution. PUBLIC; EXTRINSIC
-           ;GPL CHANGED PARAMETER TO ADUZ TO KEEP $$SITE^VASITE FROM CRASHING 
-        ; INPUT: DUZ ByVal
-        ; Output: String.
-        ; See ADD1 for comments
-        N INST S INST=$P($$SITE^VASITE(),U)
-        N ADD
-        S ADD=$$MADD^XUAF4(INST) ; mailing address
-        Q:$L(ADD) $P(ADD,U,2)
-        S ADD=$$PADD^XUAF4(INST) ; physical address
-        Q:$L(ADD) $P(ADD,U,2)
-        Q ""
-        ;
-STATE(ADUZ) ; Get State for Institution. PUBLIC; EXTRINSIC
-        ; INPUT: DUZ ByVal
-        ; Output: String.
-        ; See ADD1 for comments
-        N INST S INST=$P($$SITE^VASITE(),U)
-        N ADD
-        S ADD=$$MADD^XUAF4(INST) ; mailing address
-        Q:$L(ADD) $P(ADD,U,3)
-        S ADD=$$PADD^XUAF4(INST) ; physical address
-        Q:$L(ADD) $P(ADD,U,3)
-        Q ""
-        ;
-POSTCODE(ADUZ) ; Get Postal Code for Institution. PUBLIC; EXTRINSIC
-        ; INPUT: DUZ ByVal
-        ; OUTPUT: String.
-        ; See ADD1 for comments
-        N INST S INST=$P($$SITE^VASITE(),U)
-        N ADD
-        S ADD=$$MADD^XUAF4(INST) ; mailing address
-        Q:$L(ADD) $P(ADD,U,4)
-        S ADD=$$PADD^XUAF4(INST) ; physical address
-        Q:$L(ADD) $P(ADD,U,4)
-        Q ""
-        ;
-TEL(DUZ) ; Get Office Phone number. PUBLIC; EXTRINSIC
-        ; INPUT: DUZ ByVal
-        ; OUTPUT: String.
-        ; Direct global access
-        N TEL S TEL=$G(^VA(200,DUZ,.13))
-        Q $P(TEL,U,2)
-        ;
-TELTYPE(DUZ) ; Get Telephone Type. PUBLIC; EXTRINSIC
-        ; INPUT: DUZ ByVal
-        ; OUTPUT: String.
-        Q "Office"
-        ;
-EMAIL(DUZ) ; Get Provider's Email. PUBLIC; EXTRINSIC
-        ; INPUT: DUZ ByVal
-        ; OUTPUT: String
-        ; Direct global access
-        N EMAIL S EMAIL=$G(^VA(200,DUZ,.15))
-        Q $P(EMAIL,U)
-        ;
+ 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
+  N NAME S NAME=$P(^VA(200,DUZ,0),U)
+  D NAMECOMP^XLFNAME(.NAME)
+  Q NAME("FAMILY")
+  ;
+GIVEN(DUZ)      ; Get Given Name; PUBLIC; EXTRINSIC
+  ; INPUT: DUZ ByVal
+  ; OUTPUT: String
+  N NAME S NAME=$P(^VA(200,DUZ,0),U)
+  D NAMECOMP^XLFNAME(.NAME)
+  Q NAME("GIVEN")
+  ;
+MIDDLE(DUZ)     ; Get Middle Name, PUBLIC; EXTRINSIC
+  ; INPUT: DUZ ByVal
+  ; OUTPUT: String
+  N NAME S NAME=$P(^VA(200,DUZ,0),U)
+  D NAMECOMP^XLFNAME(.NAME)
+  Q NAME("MIDDLE")
+  ;
+SUFFIX(DUZ)     ; Get Suffix Name, PUBLIC; EXTRINSIC
+  ; INPUT: DUZ ByVal
+  ; OUTPUT: String
+  N NAME S NAME=$P(^VA(200,DUZ,0),U)
+  D NAMECOMP^XLFNAME(.NAME)
+  Q NAME("SUFFIX")
+  ;
+TITLE(DUZ)      ; Get Title for Proivder, PUBLIC; EXTRINSIC
+  ; INPUT: DUZ ByVal
+  ; OUTPUT: String
+  ; Gets External Value of Title field in New Person File.
+  ; It's actually a pointer to file 3.1
+  ; 200=New Person File; 8 is Title Field
+  Q $$GET1^DIQ(200,DUZ_",",8)
+  ;
+NPI(DUZ)        ; Get NPI Number, PUBLIC; EXTRINSIC
+  ; INPUT: DUZ ByVal
+  ; OUTPUT: Delimited String in format:
+  ; IDType^ID^IDDescription
+  ; If the NPI doesn't exist, "" is returned.
+  ; This routine uses a call documented in the Kernel dev guide
+  ; This call returns as "NPI^TimeEntered^ActiveInactive"
+  ; It returns -1 for NPI if NPI doesn't exist.
+  N NPI S NPI=$P($$NPI^XUSNPI("Individual_ID",DUZ),U)
+  Q:NPI=-1 ""
+  Q "NPI^"_NPI_"^HHS"
+  ;
+SPEC(DUZ)       ; Get Provider Specialty, PUBLIC; EXTRINSIC
+  ; INPUT: DUZ ByVal
+  ; 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
+  N STR S STR=$$GET^XUA4A72(DUZ)
+  Q:+STR<0 ""
+  ; Sometimes we have 3 pieces, or 2. Deal with that.
+  Q:$L($P(STR,U,4)) $P(STR,U,2)_"-"_$P(STR,U,3)_"-"_$P(STR,U,4)
+  Q $P(STR,U,2)_"-"_$P(STR,U,3)
+  ;
+ADDTYPE(DUZ)    ; Get Address Type, PUBLIC; EXTRINSIC
+  ; INPUT: DUZ, but not needed really... here for future expansion
+  ; OUTPUT: At this point "Work"
+  Q "Work"
+  ;
+ADDLINE1(ADUZ)  ; Get Address associated with this instituation; PUBLIC; EXTRINSIC ; CHANGED PARAMETER TO ADUZ TO KEEP FROM CRASHING GPL 1/09
+  ; 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
+  ; one we want to use; then check for physical. If neither exists,
+  ; then we return nothing. We check for the existence of an address
+  ; by the length of the returned string.
+  ; NOTE: API doesn't support Address 2, so I won't even include it
+  ; in the template.
+  N ADD
+  S ADD=$$MADD^XUAF4(INST) ; mailing address
+  Q:$L(ADD) $P(ADD,U)
+  S ADD=$$PADD^XUAF4(INST) ; physical address
+  Q:$L(ADD) $P(ADD,U)
+  Q ""
+  ;
+CITY(ADUZ)      ; Get City for Institution. PUBLIC; EXTRINSIC
+    ;GPL CHANGED PARAMETER TO ADUZ TO KEEP $$SITE^VASITE FROM CRASHING 
+  ; INPUT: DUZ ByVal
+  ; Output: String.
+  ; See ADD1 for comments
+  N INST S INST=$P($$SITE^VASITE(),U)
+  N ADD
+  S ADD=$$MADD^XUAF4(INST) ; mailing address
+  Q:$L(ADD) $P(ADD,U,2)
+  S ADD=$$PADD^XUAF4(INST) ; physical address
+  Q:$L(ADD) $P(ADD,U,2)
+  Q ""
+  ;
+STATE(ADUZ)     ; Get State for Institution. PUBLIC; EXTRINSIC
+  ; INPUT: DUZ ByVal
+  ; Output: String.
+  ; See ADD1 for comments
+  N INST S INST=$P($$SITE^VASITE(),U)
+  N ADD
+  S ADD=$$MADD^XUAF4(INST) ; mailing address
+  Q:$L(ADD) $P(ADD,U,3)
+  S ADD=$$PADD^XUAF4(INST) ; physical address
+  Q:$L(ADD) $P(ADD,U,3)
+  Q ""
+  ;
+POSTCODE(ADUZ)  ; Get Postal Code for Institution. PUBLIC; EXTRINSIC
+  ; INPUT: DUZ ByVal
+  ; OUTPUT: String.
+  ; See ADD1 for comments
+  N INST S INST=$P($$SITE^VASITE(),U)
+  N ADD
+  S ADD=$$MADD^XUAF4(INST) ; mailing address
+  Q:$L(ADD) $P(ADD,U,4)
+  S ADD=$$PADD^XUAF4(INST) ; physical address
+  Q:$L(ADD) $P(ADD,U,4)
+  Q ""
+  ;
+TEL(DUZ)        ; Get Office Phone number. PUBLIC; EXTRINSIC
+  ; INPUT: DUZ ByVal
+  ; OUTPUT: String.
+  ; Direct global access
+  N TEL S TEL=$G(^VA(200,DUZ,.13))
+  Q $P(TEL,U,2)
+  ;
+TELTYPE(DUZ)    ; Get Telephone Type. PUBLIC; EXTRINSIC
+  ; INPUT: DUZ ByVal
+  ; OUTPUT: String.
+  Q "Office"
+  ;
+EMAIL(DUZ)      ; Get Provider's Email. PUBLIC; EXTRINSIC
+  ; INPUT: DUZ ByVal
+  ; OUTPUT: String
+  ; Direct global access
+  N EMAIL S EMAIL=$G(^VA(200,DUZ,.15))
+  Q $P(EMAIL,U)
+  ;

ccr/trunk/p/C0CVITAL.m

@@ -1 @@
-C0CVITAL ; CCDCCR/CJE/GPL - CCR/CCD PROCESSING FOR VITALS ; 07/16/08
- ;;0.1;CCDCCR;;JUL 16,2008;
+C0CVITAL        ; CCDCCR/CJE/GPL - CCR/CCD PROCESSING FOR VITALS ; 07/16/08
+ ;;1.0;C0C;;May 19, 2009;
  ;Copyright 2008,2009 George Lilly, University of Minnesota and others.
  ;Licensed under the terms of the GNU General Public License.
@@ -22 +22 @@
  Q
  ;
-EXTRACT(VITXML,DFN,VITOUTXML) ; EXTRACT VITALS INTO PROVIDED XML TEMPLATE
+EXTRACT(VITXML,DFN,VITOUTXML)   ; EXTRACT VITALS INTO PROVIDED XML TEMPLATE
  ;
  ; VITXML AND OUTXML ARE PASSED BY NAME SO GLOBALS CAN BE USED
@@ -191 +191 @@
  Q
  ;
-VITDATES(VDT) ; VDT IS PASSED BY REFERENCE AND WILL CONTAIN THE ARRAY
+VITDATES(VDT)   ; VDT IS PASSED BY REFERENCE AND WILL CONTAIN THE ARRAY
  ; OF DATES IN THE VITALS RESULTS
  N VDTI,VDTJ,VTDCNT

ccr/trunk/p/C0CXPAT0.m

@@ -1 @@
-C0CXPAT0   ; CCDCCR/GPL - XPATH TEST CASES ; 6/1/08
- ;;0.2;CCDCCR;nopatch;noreleasedate
+C0CXPAT0          ; CCDCCR/GPL - XPATH TEST CASES ; 6/1/08
+ ;;1.0;C0C;;May 19, 2009;
  ;Copyright 2008 George Lilly.  Licensed under the terms of the GNU
  ;General Public License See attached copy of the License.

ccr/trunk/p/C0CXPATH.m

@@ -1 @@
-C0CXPATH   ; CCDCCR/GPL - XPATH XML manipulation utilities; 6/1/08
- ;;0.2;CCDCCR;nopatch;noreleasedate
+C0CXPATH          ; CCDCCR/GPL - XPATH XML manipulation utilities; 6/1/08
+ ;;1.0;C0C;;May 19, 2009;
  ;Copyright 2008 George Lilly.  Licensed under the terms of the GNU
  ;General Public License See attached copy of the License.
@@ -22 +22 @@
  Q
  ;
-OUTPUT(OUTARY,OUTNAME,OUTDIR)   ; WRITE AN ARRAY TO A FILE
+OUTPUT(OUTARY,OUTNAME,OUTDIR)     ; WRITE AN ARRAY TO A FILE
  ;
  N Y
@@ -30 +30 @@
  Q
  ;
-PUSH(STK,VAL)   ; pushs VAL onto STK and updates STK(0)
+PUSH(STK,VAL)     ; pushs VAL onto STK and updates STK(0)
  ;  VAL IS A STRING AND STK IS PASSED BY NAME
  ;
@@ -38 +38 @@
  Q
  ;
-POP(STK,VAL)    ; POPS THE LAST VALUE OFF THE STK AND RETURNS IT IN VAL
+POP(STK,VAL)       ; POPS THE LAST VALUE OFF THE STK AND RETURNS IT IN VAL
  ; VAL AND STK ARE PASSED BY REFERENCE
  ;
@@ -50 +50 @@
  Q
  ;
-PUSHA(ADEST,ASRC) ; PUSH ASRC ONTO ADEST, BOTH PASSED BY NAME
+PUSHA(ADEST,ASRC)       ; PUSH ASRC ONTO ADEST, BOTH PASSED BY NAME
  ;
  N ZGI
@@ -57 +57 @@
  Q
  ;
-MKMDX(STK,RTN)  ; MAKES A MUMPS INDEX FROM THE ARRAY STK
+MKMDX(STK,RTN)   ; MAKES A MUMPS INDEX FROM THE ARRAY STK
  ; RTN IS SET TO //FIRST/SECOND/THIRD FOR THREE ARRAY ELEMENTS
  S RTN=""
@@ -68 +68 @@
  Q
  ;
-XNAME(ISTR)     ; FUNCTION TO EXTRACT A NAME FROM AN XML FRAG
+XNAME(ISTR)         ; FUNCTION TO EXTRACT A NAME FROM AN XML FRAG
  ;  </NAME> AND <NAME ID=XNAME> WILL RETURN NAME
  ; ISTR IS PASSED BY VALUE
@@ -83 +83 @@
  Q CUR
  ;
-INDEX(ZXML)     ; parse the XML in ZXML and produce an XPATH index
+INDEX(ZXML)         ; parse the XML in ZXML and produce an XPATH index
  ; ex. ZXML(FIRST,SECOND,THIRD,FOURTH)=FIRSTLINE^LASTLINE
  ; WHERE FIRSTLINE AND LASTLINE ARE THE BEGINNING AND ENDING OF THE
@@ -141 +141 @@
  Q
  ;
-QUERY(IARY,XPATH,OARY)  ; RETURNS THE XML ARRAY MATCHING THE XPATH EXPRESSION
+QUERY(IARY,XPATH,OARY)   ; RETURNS THE XML ARRAY MATCHING THE XPATH EXPRESSION
  ; XPATH IS OF THE FORM "//FIRST/SECOND/THIRD"
  ; IARY AND OARY ARE PASSED BY NAME
@@ -163 +163 @@
  Q
  ;
-XF(IDX,XPATH)   ; EXTRINSIC TO RETURN THE STARTING LINE FROM AN XPATH
+XF(IDX,XPATH)     ; EXTRINSIC TO RETURN THE STARTING LINE FROM AN XPATH
  ; INDEX WITH TWO PIECES START^FINISH
  ; IDX IS PASSED BY NAME
  Q $P(@IDX@(XPATH),"^",1)
  ;
-XL(IDX,XPATH)   ; EXTRINSIC TO RETURN THE LAST LINE FROM AN XPATH
+XL(IDX,XPATH)     ; EXTRINSIC TO RETURN THE LAST LINE FROM AN XPATH
  ; INDEX WITH TWO PIECES START^FINISH
  ; IDX IS PASSED BY NAME
  Q $P(@IDX@(XPATH),"^",2)
  ;
-START(ISTR)     ; EXTRINSIC TO RETURN THE STARTING LINE FROM AN INDEX
+START(ISTR)         ; EXTRINSIC TO RETURN THE STARTING LINE FROM AN INDEX
  ; TYPE STRING WITH THREE PIECES ARRAY;START;FINISH
  ; COMPANION TO FINISH ; IDX IS PASSED BY NAME
  Q $P(ISTR,";",2)
  ;
-FINISH(ISTR)    ; EXTRINSIC TO RETURN THE LAST LINE FROM AN INDEX
+FINISH(ISTR)       ; EXTRINSIC TO RETURN THE LAST LINE FROM AN INDEX
  ; TYPE STRING WITH THREE PIECES ARRAY;START;FINISH
  Q $P(ISTR,";",3)
  ;
-ARRAY(ISTR)     ; EXTRINSIC TO RETURN THE ARRAY REFERENCE FROM AN INDEX
+ARRAY(ISTR)         ; EXTRINSIC TO RETURN THE ARRAY REFERENCE FROM AN INDEX
  ; TYPE STRING WITH THREE PIECES ARRAY;START;FINISH
  Q $P(ISTR,";",1)
  ;
-BUILD(BLIST,BDEST)      ; A COPY MACHINE THAT TAKE INSTRUCTIONS IN ARRAY BLIST
+BUILD(BLIST,BDEST)           ; A COPY MACHINE THAT TAKE INSTRUCTIONS IN ARRAY BLIST
  ; WHICH HAVE ARRAY;START;FINISH AND COPIES THEM TO DEST
  ; DEST IS CLEARED TO START
@@ -204 +204 @@
  Q
  ;
-QUEUE(BLST,ARRAY,FIRST,LAST)    ; ADD AN ENTRY TO A BLIST
+QUEUE(BLST,ARRAY,FIRST,LAST)       ; ADD AN ENTRY TO A BLIST
  ;
  I DEBUG W "QUEUEING ",BLST,!
@@ -210 +210 @@
  Q
  ;
-CP(CPSRC,CPDEST)        ; COPIES CPSRC TO CPDEST BOTH PASSED BY NAME
+CP(CPSRC,CPDEST)               ; COPIES CPSRC TO CPDEST BOTH PASSED BY NAME
  ; KILLS CPDEST FIRST
  N CPINSTR
@@ -222 +222 @@
  Q
  ;
-QOPEN(QOBLIST,QOXML,QOXPATH)    ; ADD ALL BUT THE LAST LINE OF QOXML TO QOBLIST
+QOPEN(QOBLIST,QOXML,QOXPATH)       ; ADD ALL BUT THE LAST LINE OF QOXML TO QOBLIST
  ; WARNING NEED TO DO QCLOSE FOR SAME XML BEFORE CALLING BUILD
  ; QOXPATH IS OPTIONAL - WILL OPEN INSIDE THE XPATH POINT
@@ -242 +242 @@
  Q
  ;
-QCLOSE(QCBLIST,QCXML,QCXPATH)   ; CLOSE XML AFTER A QOPEN
+QCLOSE(QCBLIST,QCXML,QCXPATH)     ; CLOSE XML AFTER A QOPEN
  ; ADDS THE LIST LINE OF QCXML TO QCBLIST
  ; USED TO FINISH INSERTING CHILDERN NODES
@@ -261 +261 @@
  Q
  ;
-INSERT(INSXML,INSNEW,INSXPATH)  ; INSERT INSNEW INTO INSXML AT THE
+INSERT(INSXML,INSNEW,INSXPATH)   ; INSERT INSNEW INTO INSXML AT THE
  ; INSXPATH XPATH POINT INSXPATH IS OPTIONAL - IF IT IS
  ; OMITTED, INSERTION WILL BE AT THE ROOT
@@ -287 +287 @@
  Q
  ;
-INSINNER(INNXML,INNNEW,INNXPATH)        ; INSERT THE INNER XML OF INNNEW
+INSINNER(INNXML,INNNEW,INNXPATH)               ; INSERT THE INNER XML OF INNNEW
  ; INTO INNXML AT THE INNXPATH XPATH POINT
  ;
@@ -307 +307 @@
  Q
  ;
-INSB4(XDEST,XNEW) ; INSERT XNEW AT THE BEGINNING OF XDEST
+INSB4(XDEST,XNEW)       ; INSERT XNEW AT THE BEGINNING OF XDEST
  ; BUT XDEST AN XNEW ARE PASSED BY NAME
  N XBLD,XTMP
@@ -318 +318 @@
  Q
  ;
-REPLACE(REXML,RENEW,REXPATH)    ; REPLACE THE XML AT THE XPATH POINT
+REPLACE(REXML,RENEW,REXPATH)       ; REPLACE THE XML AT THE XPATH POINT
  ; WITH RENEW - NOTE THIS WILL DELETE WHAT WAS THERE BEFORE
  ; REXML AND RENEW ARE PASSED BY NAME XPATH IS A VALUE
@@ -342 +342 @@
  Q
  ;
-MISSING(IXML,OARY)      ; SEARTH THROUGH INXLM AND PUT ANY @@X@@ VARS IN OARY
+MISSING(IXML,OARY)           ; SEARTH THROUGH INXLM AND PUT ANY @@X@@ VARS IN OARY
  ; W "Reporting on the missing",!
  ; W OARY
@@ -354 +354 @@
  Q
  ;
-MAP(IXML,INARY,OXML)    ; SUBSTITUTE MULTIPLE @@X@@ VARS WITH VALUES IN INARY
+MAP(IXML,INARY,OXML)       ; SUBSTITUTE MULTIPLE @@X@@ VARS WITH VALUES IN INARY
  ; AND PUT THE RESULTS IN OXML
  I '$D(@IXML@(0)) W "MALFORMED XML PASSED TO MAP",! Q
@@ -379 +379 @@
  Q
  ;
-DOFLD ; PROCESS A FILEMAN FIELD REFERENCED BY A VARIABLE
- ;
- Q
- ;
-TRIM(THEXML) ; TAKES OUT ALL NULL ELEMENTS
+DOFLD   ; PROCESS A FILEMAN FIELD REFERENCED BY A VARIABLE
+ ;
+ Q
+ ;
+TRIM(THEXML)    ; TAKES OUT ALL NULL ELEMENTS
  ; THEXML IS PASSED BY NAME
  N I,J,TMPXML,DEL,FOUND,INTXT
@@ -421 +421 @@
  Q FOUND
  ;
-UNMARK(XSEC) ; REMOVE MARKUP FROM FIRST AND LAST LINE OF XML
+UNMARK(XSEC)    ; REMOVE MARKUP FROM FIRST AND LAST LINE OF XML
  ; XSEC IS A SECTION PASSED BY NAME
  N XBLD,XTMP
@@ -429 +429 @@
  Q
  ;
-PARY(GLO)       ;PRINT AN ARRAY
+PARY(GLO)             ;PRINT AN ARRAY
  N I
  F I=1:1:@GLO@(0) W I_" "_@GLO@(I),!
  Q
  ;
-H2ARY(IARYRTN,IHASH,IPRE) ; CONVERT IHASH TO RETURN ARRAY
+H2ARY(IARYRTN,IHASH,IPRE)       ; CONVERT IHASH TO RETURN ARRAY
  ; IPRE IS OPTIONAL PREFIX FOR THE ELEMENTS. USED FOR MUPTIPLES 1^"VAR"^VALUE
  I '$D(IPRE) S IPRE=""
@@ -460 +460 @@
  Q
  ;
-XVARS(XVRTN,XVIXML) ; RETURNS AN ARRAY XVRTN OF ALL UNIQUE VARIABLES
+XVARS(XVRTN,XVIXML)     ; RETURNS AN ARRAY XVRTN OF ALL UNIQUE VARIABLES
  ; DEFINED IN INPUT XML XVIXML BY @@VAR@@
  ; XVRTN AND XVIXML ARE PASSED BY NAME
@@ -471 +471 @@
  Q
  ;
-DXVARS(DXIN) ;DISPLAY ALL VARIABLES IN A TEMPLATE
+DXVARS(DXIN)    ;DISPLAY ALL VARIABLES IN A TEMPLATE
  ; IF PARAMETERS ARE NULL, DEFAULTS TO CCR TEMPLATE
  ;
@@ -487 +487 @@
  Q
  ;
-TEST     ; Run all the test cases
+TEST        ; Run all the test cases
  D TESTALL^C0CUNIT("C0CXPAT0")
  Q
  ;
-ZTEST(WHICH)    ; RUN ONE SET OF TESTS
+ZTEST(WHICH)       ; RUN ONE SET OF TESTS
  N ZTMP
  S DEBUG=1
@@ -498 +498 @@
  Q
  ;
-TLIST   ; LIST THE TESTS
+TLIST     ; LIST THE TESTS
  N ZTMP
  D ZLOAD^C0CUNIT("ZTMP","C0CXPAT0")

ccr/trunk/p/LA7QRY1.m

@@ -1 +1 @@
 LA7QRY1 ;DALOI/JMC - Lab HL7 Query Utility ;01/19/99  13:48
- ;;5.2;AUTOMATED LAB INSTRUMENTS;**46,61**;Sep 27, 1994;Build 26
- ;
- Q
- ;
+        ;;5.2;AUTOMATED LAB INSTRUMENTS;**46,61**;Sep 27, 1994;Build 31
+        ;
+        Q
+        ;
 CHKSC   ; Check search NLT/LOINC codes
- ;
- N J
- ;
- S J=0
- F  S J=$O(LA7SC(J)) Q:'J  D
- . N X
- . S X=LA7SC(J)
- . I $P(X,"^",2)="NLT",$D(^LAM("E",$P(X,"^"))) D  Q
- . . S ^TMP("LA7-NLT",$J,$P(X,"^"))=""
- . I $P(X,"^",2)="LN",$D(^LAB(95.3,$P($P(X,"^"),"-"))) D  Q
- . . S ^TMP("LA7-LN",$J,$P($P(X,"^"),"-"))=""
- . S LA7ERR(6)="Unknown search code "_$P(X,"^")_" passed"
- . K LA7SC(J)
- Q
- ;
- ;
+        ;
+        N J
+        ;
+        S J=0
+        F  S J=$O(LA7SC(J)) Q:'J  D
+        . N X
+        . S X=LA7SC(J)
+        . I $P(X,"^",2)="NLT",$D(^LAM("E",$P(X,"^"))) D  Q
+        . . S ^TMP("LA7-NLT",$J,$P(X,"^"))=""
+        . I $P(X,"^",2)="LN",$D(^LAB(95.3,$P($P(X,"^"),"-"))) D  Q
+        . . S ^TMP("LA7-LN",$J,$P($P(X,"^"),"-"))=""
+        . S LA7ERR(6)="Unknown search code "_$P(X,"^")_" passed"
+        . K LA7SC(J)
+        Q
+        ;
+        ;
 SPEC    ; Convert HL7 Specimen Codes to File #61, Topography codes
- ; Find all topographies that use this HL7 specimen code
- N J,K,L
- ;
- S J=0
- F  S J=$O(LA7SPEC(J)) Q:'J  D
- . S K=LA7SPEC(J),L=0
- . F  S L=$O(^LAB(61,"HL7",K,L)) Q:'L  S ^TMP("LA7-61",$J,L)=""
- Q
- ;
- ;
+        ; Find all topographies that use this HL7 specimen code
+        N J,K,L
+        ;
+        S J=0
+        F  S J=$O(LA7SPEC(J)) Q:'J  D
+        . S K=LA7SPEC(J),L=0
+        . F  S L=$O(^LAB(61,"HL7",K,L)) Q:'L  S ^TMP("LA7-61",$J,L)=""
+        Q
+        ;
+        ;
 BUILDMSG        ; Build HL7 message with result of query
- ;
- N HL,HLECH,HLFS,HLQ,LA,LA763,LA7ECH,LA7FS,LA7MSH,LA7NOMSG,LA7NTESN,LA7NVAF,LA7OBRSN,LA7OBXSN,LA7PIDSN,LA7ROOT,LA7X,X
- ;
- I $L($G(LA7HL7))'=5 S LA7HL7="|^\~&"
- S (HL("FS"),HLFS,LA7FS)=$E(LA7HL7),(HL("ECH"),HLECH,LA7ECH)=$E(LA7HL7,2,5)
- S (HLQ,HL("Q"))=""""""
- ; Set flag to not send HL7 message
- S LA7NOMSG=1
- ; Create dummy MSH to pass HL7 delimiters
- S LA7MSH(0)="MSH"_LA7FS_LA7ECH_LA7FS
- D FILESEG^LA7VHLU(GBL,.LA7MSH)
- ;
- F X="AUTO-INST","LRDFN","LRIDT","SUB","HUID","NLT","RUID","SITE" S LA(X)=""
- ;
- ; Take search results and put in HL7 message structure
- S LA7ROOT="^TMP(""LA7-QRY"",$J)",(LA7QUIT,LA7PIDSN)=0
- ; F  S LA7ROOT=$Q(@LA7ROOT) Q:LA7QUIT  D ;change per John M
- F  S LA7ROOT=$Q(@LA7ROOT) Q:LA7ROOT=""  D  Q:LA7QUIT
- . I $QS(LA7ROOT,1)'="LA7-QRY"!($QS(LA7ROOT,2)'=$J) S LA7QUIT=1 Q
- . I LA("LRDFN")'=$QS(LA7ROOT,3) D PID S LA7OBRSN=0
- . I LA("LRIDT")'=$QS(LA7ROOT,4) D ORC,OBR
- . I LA("SUB")'=$QS(LA7ROOT,5) D ORC,OBR
- . I LA("NLT")'=$P($QS(LA7ROOT,6),"!") D ORC,OBR
- . D OBX
- ;
- Q
- ;
- ;
+        ;
+        N HL,HLECH,HLFS,HLQ,LA,LA763,LA7ECH,LA7FS,LA7MSH,LA7NOMSG,LA7NTESN,LA7NVAF,LA7OBRSN,LA7OBXSN,LA7PIDSN,LA7ROOT,LA7X,X
+        ;
+        I $L($G(LA7HL7))'=5 S LA7HL7="|^\~&"
+        S (HL("FS"),HLFS,LA7FS)=$E(LA7HL7),(HL("ECH"),HLECH,LA7ECH)=$E(LA7HL7,2,5)
+        S (HLQ,HL("Q"))=""""""
+        ; Set flag to not send HL7 message
+        S LA7NOMSG=1
+        ; Create dummy MSH to pass HL7 delimiters
+        S LA7MSH(0)="MSH"_LA7FS_LA7ECH_LA7FS
+        D FILESEG^LA7VHLU(GBL,.LA7MSH)
+        ;
+        F X="AUTO-INST","LRDFN","LRIDT","SUB","HUID","NLT","RUID","SITE" S LA(X)=""
+        ;
+        ; Take search results and put in HL7 message structure
+        S LA7ROOT="^TMP(""LA7-QRY"",$J)",(LA7QUIT,LA7PIDSN)=0
+        ; F  S LA7ROOT=$Q(@LA7ROOT) Q:LA7QUIT  D ;change per John M
+        F  S LA7ROOT=$Q(@LA7ROOT) Q:LA7ROOT=""  D  Q:LA7QUIT
+        . I $QS(LA7ROOT,1)'="LA7-QRY"!($QS(LA7ROOT,2)'=$J) S LA7QUIT=1 Q
+        . I LA("LRDFN")'=$QS(LA7ROOT,3) D PID S LA7OBRSN=0
+        . I LA("LRIDT")'=$QS(LA7ROOT,4) D ORC,OBR
+        . I LA("SUB")'=$QS(LA7ROOT,5) D ORC,OBR
+        . I LA("NLT")'=$P($QS(LA7ROOT,6),"!") D ORC,OBR
+        . D OBX
+        ;
+        Q
+        ;
+        ;
 PID     ; Build PID segment
- ;
- N LA7PID
- ;
- S (LA("LRDFN"),LRDFN)=$QS(LA7ROOT,3)
- S LRDPF=$P(^LR(LRDFN,0),"^",2),DFN=$P(^(0),"^",3)
- D DEM^LRX
- D PID^LA7VPID(LA("LRDFN"),"",.LA7PID,.LA7PIDSN,.HL)
- D FILESEG^LA7VHLU(GBL,.LA7PID)
- S (LA("LRIDT"),LA("SUB"))=""
- Q
- ;
- ;
+        ;
+        N LA7PID
+        ;
+        S (LA("LRDFN"),LRDFN)=$QS(LA7ROOT,3)
+        S LRDPF=$P(^LR(LRDFN,0),"^",2),DFN=$P(^(0),"^",3)
+        D DEM^LRX
+        D PID^LA7VPID(LA("LRDFN"),"",.LA7PID,.LA7PIDSN,.HL)
+        D FILESEG^LA7VHLU(GBL,.LA7PID)
+        S (LA("LRIDT"),LA("SUB"))=""
+        Q
+        ;
+        ;
 ORC     ; Build ORC segment
- ;
- N X
- ;
- S LA("LRIDT")=$QS(LA7ROOT,4),LA("SUB")=$QS(LA7ROOT,5)
- S LA763(0)=$G(^LR(LA("LRDFN"),LA("SUB"),LA("LRIDT"),0))
- S X=$G(^LR(LA("LRDFN"),LA("SUB"),LA("LRIDT"),"ORU"))
- S LA("HUID")=$P(X,"^"),LA("SITE")=$P(X,"^",2),LA("RUID")=$P(X,"^",4)
- I LA("HUID")="" S LA("HUID")=$P(LA763(0),"^",6)
- S LA7NVAF=$$NVAF^LA7VHLU2(0),LA7NTESN=0
- D ORC^LA7VORU
- S LA("NLT")=""
- ;
- Q
- ;
- ;
+        ;
+        N X
+        ;
+        S LA("LRIDT")=$QS(LA7ROOT,4),LA("SUB")=$QS(LA7ROOT,5)
+        S LA763(0)=$G(^LR(LA("LRDFN"),LA("SUB"),LA("LRIDT"),0))
+        S X=$G(^LR(LA("LRDFN"),LA("SUB"),LA("LRIDT"),"ORU"))
+        S LA("HUID")=$P(X,"^"),LA("SITE")=$P(X,"^",2),LA("RUID")=$P(X,"^",4)
+        I LA("HUID")="" S LA("HUID")=$P(LA763(0),"^",6)
+        S LA7NVAF=$$NVAF^LA7VHLU2(0),LA7NTESN=0
+        D ORC^LA7VORU
+        S LA("NLT")=""
+        ;
+        Q
+        ;
+        ;
 OBR     ; Build OBR segment
- ;
- N LA764,LA7NLT
- ;
- S (LA("NLT"),LA7NLT)=$P($QS(LA7ROOT,6),"!"),(LA764,LA("ORD"))=""
- I $L(LA7NLT) D
- . S LA764=+$O(^LAM("E",LA7NLT,0))
- . I LA764 S LA("ORD")=$$GET1^DIQ(64,LA764_",",.01)
- I LA("SUB")="CH" D
- . D OBR^LA7VORU
- . D NTE^LA7VORU
- . S LA7OBXSN=0
- ;
- Q
- ;
- ;
+        ;
+        N LA764,LA7NLT
+        ;
+        S (LA("NLT"),LA7NLT)=$P($QS(LA7ROOT,6),"!"),(LA764,LA("ORD"))=""
+        I $L(LA7NLT) D
+        . S LA764=+$O(^LAM("E",LA7NLT,0))
+        . I LA764 S LA("ORD")=$$GET1^DIQ(64,LA764_",",.01)
+        I LA("SUB")="CH" D
+        . D OBR^LA7VORU
+        . D NTE^LA7VORU
+        . S LA7OBXSN=0
+        ;
+        Q
+        ;
+        ;
 OBX     ; Build OBX segment
- ;
- N LA7DATA,LA7VT
- ;
- S LA7NTESN=0
- I LA("SUB")="MI" D MI^LA7VORU1 Q
- I "CYEMSP"[LA("SUB") D AP^LA7VORU2 Q
- ;
- S LA7VT=$QS(LA7ROOT,7)
- D OBX^LA7VOBX(LA("LRDFN"),LA("SUB"),LA("LRIDT"),LA7VT,.LA7DATA,.LA7OBXSN,LA7FS,LA7ECH)
- I '$D(LA7DATA) Q
- D FILESEG^LA7VHLU(GBL,.LA7DATA)
- ; Send any test interpretation from file #60
- D INTRP^LA7VORUA
- ;
- Q
+        ;
+        N LA7DATA,LA7VT
+        ;
+        S LA7NTESN=0
+        I LA("SUB")="MI" D MI^LA7VORU1 Q
+        I "CYEMSP"[LA("SUB") D AP^LA7VORU2 Q
+        ;
+        S LA7VT=$QS(LA7ROOT,7)
+        D OBX^LA7VOBX(LA("LRDFN"),LA("SUB"),LA("LRIDT"),LA7VT,.LA7DATA,.LA7OBXSN,LA7FS,LA7ECH)
+        I '$D(LA7DATA) Q
+        D FILESEG^LA7VHLU(GBL,.LA7DATA)
+        ; Send any test interpretation from file #60
+        D INTRP^LA7VORUA
+        ;
+        Q