Index: /ccr/trunk/p/C0CACTOR.m
===================================================================
--- /ccr/trunk/p/C0CACTOR.m	(revision 507)
+++ /ccr/trunk/p/C0CACTOR.m	(revision 508)
@@ -1,4 +1,4 @@
-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,5 +27,5 @@
  ; 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,5 +83,5 @@
  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,5 +142,5 @@
  Q
  ;
-SYSTEM(INXML,AIEN,AOID,OUTXML) ; PROCESS A SYSTEM ACTOR
+SYSTEM(INXML,AIEN,AOID,OUTXML)	; PROCESS A SYSTEM ACTOR
      ;
      ; N AMAP
@@ -154,5 +154,5 @@
      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,5 +167,5 @@
      Q
      ;
-ORG(INXML,AIEN,AOID,OUTXML) ; PROCESS AN ORGANIZATION TYPE ACTOR
+ORG(INXML,AIEN,AOID,OUTXML)	; PROCESS AN ORGANIZATION TYPE ACTOR
      ;
      ; N AMAP
@@ -178,5 +178,5 @@
      Q
      ;
-PROVIDER(INXML,AIEN,AOID,OUTXML) ; PROCESS A PROVIDER TYPE ACTOR
+PROVIDER(INXML,AIEN,AOID,OUTXML)	; PROCESS A PROVIDER TYPE ACTOR
      ;
      ; N AMAP
Index: /ccr/trunk/p/C0CALERT.m
===================================================================
--- /ccr/trunk/p/C0CALERT.m	(revision 507)
+++ /ccr/trunk/p/C0CALERT.m	(revision 508)
@@ -1,4 +1,4 @@
-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,5 +22,5 @@
  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,5 +118,5 @@
  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
Index: /ccr/trunk/p/C0CBAT.m
===================================================================
--- /ccr/trunk/p/C0CBAT.m	(revision 507)
+++ /ccr/trunk/p/C0CBAT.m	(revision 508)
@@ -1,4 +1,4 @@
-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,5 +21,5 @@
  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,5 +33,5 @@
  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,5 +48,5 @@
  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,5 +146,5 @@
  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,5 +156,5 @@
  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,5 +164,5 @@
  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,5 +186,5 @@
  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,5 +197,5 @@
  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,5 +207,5 @@
  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,5 +215,5 @@
  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,5 +224,5 @@
  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
Index: /ccr/trunk/p/C0CCCD.m
===================================================================
--- /ccr/trunk/p/C0CCCD.m	(revision 507)
+++ /ccr/trunk/p/C0CCCD.m	(revision 508)
@@ -1,4 +1,4 @@
-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,5 +21,5 @@
  ; 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,5 +29,5 @@
        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,5 +49,5 @@
        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,5 +146,5 @@
     Q
     ;
-INITSTPS(TAB)  ; INITIALIZE CCR PROCESSING STEPS
+INITSTPS(TAB)	 ; INITIALIZE CCR PROCESSING STEPS
     ; TAB IS PASSED BY NAME
     W "TAB= ",TAB,!
@@ -155,5 +155,5 @@
     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,5 +168,5 @@
     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,5 +181,5 @@
     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,5 +200,5 @@
     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,9 +225,9 @@
     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,5 +235,5 @@
   Q
   ;
-TLIST  ; LIST THE TESTS
+TLIST	 ; LIST THE TESTS
   N ZTMP
   D ZLOAD^C0CUNIT("ZTMP","C0CCCR")
Index: /ccr/trunk/p/C0CCCD1.m
===================================================================
--- /ccr/trunk/p/C0CCCD1.m	(revision 507)
+++ /ccr/trunk/p/C0CCCD1.m	(revision 508)
@@ -1,4 +1,4 @@
-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,5 +23,5 @@
           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,5 +38,5 @@
           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,12 +58,12 @@
           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>
Index: /ccr/trunk/p/C0CCCR.m
===================================================================
--- /ccr/trunk/p/C0CCCR.m	(revision 507)
+++ /ccr/trunk/p/C0CCCR.m	(revision 508)
@@ -1,4 +1,4 @@
-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,5 +21,5 @@
  ; 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,5 +29,5 @@
  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,5 +41,5 @@
  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,5 +57,5 @@
  Q
  ;
-DCCR(DFN) ; DISPLAY A CCR THAT HAS JUST BEEN EXTRACTED
+DCCR(DFN)	; DISPLAY A CCR THAT HAS JUST BEEN EXTRACTED
  ;
  N G1
@@ -66,5 +66,5 @@
  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,5 +131,5 @@
  Q
  ;
-INITSTPS(TAB)  ; INITIALIZE CCR PROCESSING STEPS
+INITSTPS(TAB)	 ; INITIALIZE CCR PROCESSING STEPS
  ; TAB IS PASSED BY NAME
  I DEBUG W "TAB= ",TAB,!
@@ -143,5 +143,5 @@
  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,5 +167,5 @@
  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,9 +192,9 @@
  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,5 +202,5 @@
  Q
  ;
-TLIST  ; LIST THE TESTS
+TLIST	 ; LIST THE TESTS
  N ZTMP
  D ZLOAD^C0CUNIT("ZTMP","C0CCCR")
@@ -238,3 +238,3 @@
  ;;>>>D CCRRPC^C0CCCR(.C0C,"2","ALERTS","")
  ;;>>?@C0C@(@C0C@(0))["</Alerts>"
-
+ 
Index: /ccr/trunk/p/C0CCCR0.m
===================================================================
--- /ccr/trunk/p/C0CCCR0.m	(revision 507)
+++ /ccr/trunk/p/C0CCCR0.m	(revision 508)
@@ -1,4 +1,4 @@
-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,5 +23,5 @@
  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,5 +38,5 @@
  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,5 +58,5 @@
  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
Index: /ccr/trunk/p/C0CDPT.m
===================================================================
--- /ccr/trunk/p/C0CDPT.m	(revision 507)
+++ /ccr/trunk/p/C0CDPT.m	(revision 508)
@@ -1,4 +1,4 @@
-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,38 +87,38 @@
  ; 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,144 +126,144 @@
  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)
Index: /ccr/trunk/p/C0CFM1.m
===================================================================
--- /ccr/trunk/p/C0CFM1.m	(revision 507)
+++ /ccr/trunk/p/C0CFM1.m	(revision 508)
@@ -1,4 +1,4 @@
-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,5 +22,5 @@
  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,5 +37,5 @@
  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,5 +46,5 @@
  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,5 +93,5 @@
  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,5 +115,5 @@
  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,5 +123,5 @@
  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,5 +140,5 @@
  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,5 +150,5 @@
  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,5 +158,5 @@
  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,5 +167,5 @@
  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
Index: /ccr/trunk/p/C0CFM2.m
===================================================================
--- /ccr/trunk/p/C0CFM2.m	(revision 507)
+++ /ccr/trunk/p/C0CFM2.m	(revision 508)
@@ -1,4 +1,4 @@
-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,5 +28,5 @@
  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,5 +39,5 @@
  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,5 +54,5 @@
  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,5 +78,5 @@
  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,5 +145,5 @@
  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,5 +156,5 @@
  Q
  ;
-CHECK ; CHECKSUM EXPERIMENTS
+CHECK	; CHECKSUM EXPERIMENTS
  ;
  ;B
@@ -165,5 +165,5 @@
  Q
  ;
-CHKELS(DFN) ; CHECKSUM ALL ELEMENTS FOR  A PATIENT
+CHKELS(DFN)	; CHECKSUM ALL ELEMENTS FOR  A PATIENT
  ;
  S ZGLB=$NA(^TMP("C0CCHK"))
@@ -186,10 +186,10 @@
  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,5 +224,5 @@
  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,5 +278,5 @@
  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,5 +300,5 @@
  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,5 +308,5 @@
  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,5 +325,5 @@
  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,5 +335,5 @@
  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,5 +343,5 @@
  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,5 +352,5 @@
  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
Index: /ccr/trunk/p/C0CIMMU.m
===================================================================
--- /ccr/trunk/p/C0CIMMU.m	(revision 507)
+++ /ccr/trunk/p/C0CIMMU.m	(revision 508)
@@ -1,4 +1,4 @@
-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,5 +22,5 @@
  ; 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,5 +47,5 @@
  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
Index: /ccr/trunk/p/C0CLA7Q.m
===================================================================
--- /ccr/trunk/p/C0CLA7Q.m	(revision 507)
+++ /ccr/trunk/p/C0CLA7Q.m	(revision 508)
@@ -1,168 +1,169 @@
 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
Index: /ccr/trunk/p/C0CLABS.m
===================================================================
--- /ccr/trunk/p/C0CLABS.m	(revision 507)
+++ /ccr/trunk/p/C0CLABS.m	(revision 508)
@@ -1,4 +1,4 @@
-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,6 +19,5 @@
  ;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,5 +37,5 @@
  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,5 +114,5 @@
  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,5 +135,5 @@
  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,5 +155,5 @@
  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,5 +229,5 @@
  ;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,8 +246,8 @@
  . . . 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,5 +257,5 @@
  Q
  ;
-SETTBL ;
+SETTBL	;
  K X ; CLEAR X
  S X("PID","PID1")="1^00104^Set ID - Patient ID"
Index: /ccr/trunk/p/C0CMED.m
===================================================================
--- /ccr/trunk/p/C0CMED.m	(revision 507)
+++ /ccr/trunk/p/C0CMED.m	(revision 508)
@@ -1,81 +1,81 @@
 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
+ 
Index: /ccr/trunk/p/C0CMED1.m
===================================================================
--- /ccr/trunk/p/C0CMED1.m	(revision 507)
+++ /ccr/trunk/p/C0CMED1.m	(revision 508)
@@ -1,238 +1,238 @@
 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
+ ;
Index: /ccr/trunk/p/C0CMED2.m
===================================================================
--- /ccr/trunk/p/C0CMED2.m	(revision 507)
+++ /ccr/trunk/p/C0CMED2.m	(revision 508)
@@ -1,267 +1,267 @@
 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
+ ;
Index: /ccr/trunk/p/C0CMED3.m
===================================================================
--- /ccr/trunk/p/C0CMED3.m	(revision 507)
+++ /ccr/trunk/p/C0CMED3.m	(revision 508)
@@ -1,4 +1,4 @@
-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,5 +22,5 @@
  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)
Index: /ccr/trunk/p/C0CMED6.m
===================================================================
--- /ccr/trunk/p/C0CMED6.m	(revision 507)
+++ /ccr/trunk/p/C0CMED6.m	(revision 508)
@@ -1,329 +1,329 @@
 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
+ 
Index: /ccr/trunk/p/C0CPARMS.m
===================================================================
--- /ccr/trunk/p/C0CPARMS.m	(revision 507)
+++ /ccr/trunk/p/C0CPARMS.m	(revision 508)
@@ -1,4 +1,4 @@
 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.
Index: /ccr/trunk/p/C0CPROBS.m
===================================================================
--- /ccr/trunk/p/C0CPROBS.m	(revision 507)
+++ /ccr/trunk/p/C0CPROBS.m	(revision 508)
@@ -1,4 +1,4 @@
-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,5 +22,5 @@
  ; 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
Index: /ccr/trunk/p/C0CQRY2.m
===================================================================
--- /ccr/trunk/p/C0CQRY2.m	(revision 508)
+++ /ccr/trunk/p/C0CQRY2.m	(revision 508)
@@ -0,0 +1,184 @@
+LA7QRY2 ;DALOI/JMC - Lab HL7 Query Utility ; 04/13/09
+ ;;5.2;AUTOMATED LAB INSTRUMENTS;**46**;Sep 27, 1994
+ ; JMC - mods to check for IHS V LAB file
+ ;
+ Q
+ ;
+PATID ; Resolve patient id and establish patient environment
+ ;
+ N LA7X
+ ;
+ S (DFN,LRDFN)="",LA7PTYP=0
+ ;
+ ; SSN passed as patient identifier
+ I LA7PTID?9N.1A D
+ . S LA7PTYP=1
+ . S LA7X=$O(^DPT("SSN",LA7PTID,0))
+ . I LA7X>0 D SETDFN(LA7X)
+ ;
+ ; MPI/ICN (integration control number) passed as patient identifier
+ I LA7PTID?10N1"V"6N D
+ . S LA7PTYP=2
+ . S LA7X=$$GETDFN^MPIF001($P(LA7PTID,"V"))
+ . I LA7X>0 D SETDFN(LA7X)
+ ;
+ ; If no patient identified/no laboratory record - return exception message
+ I 'LA7PTYP S LA7ERR(1)="Invalid patient identifier passed"
+ I 'DFN S LA7ERR(2)="No patient found with requested identifier"
+ I DFN,'LRDFN S LA7ERR(3)="No laboratory record for requested patient"
+ I LRDFN,'$D(^LR(LRDFN)) S LA7ERR(4)="Database error - missing laboratory record for requested patient"
+ Q
+ ;
+ ;
+BCD ; Search by specimen collection date.
+ ;
+ N LA763,LA7QUIT
+ ;
+ S (LA7SDT(0),LA7EDT(0))=0
+ I LA7SDT S LA7SDT(0)=9999999-LA7SDT
+ I LA7EDT S LA7EDT(0)=9999999-LA7EDT
+ ;
+ F LRSS="CH","MI","SP" D
+ . S (LA7QUIT,LRIDT)=0
+ . I LA7EDT(0) S LRIDT=$O(^LR(LRDFN,LRSS,LA7EDT(0)),-1)
+ . F  S LRIDT=$O(^LR(LRDFN,LRSS,LRIDT)) Q:LA7QUIT  D
+ . . ; Quit if reached end of data or outside date criteria
+ . . I 'LRIDT!(LRIDT>LA7SDT(0)) S LA7QUIT=1 Q
+ . . D SEARCH
+ ;
+ Q
+ ;
+ ;
+BRAD ; Search by results available date (completion date).
+ ; Assumes cross-references still exist for dates in LRO(69) global.
+ ; Collects specimen date/time values for a given LRDFN and completion date.
+ ; Cross-reference is by date only, time stripped from start date.
+ ; Uses cross-reference ^LRO(69,DT,1,"AN",'LOCATION',LRDFN,LRIDT)=""
+ ;
+ N LA763,LA7DT,LA7ROOT,LA7SRC,X
+ ;
+ ; Check if orders still exist Iin file #69 for search range
+ S LA7SDT(1)=(LA7SDT\1)-.0000000001,LA7EDT(1)=(LA7EDT\1)+.24,LA7SRC=0
+ S X=$O(^LRO(69,LA7SDT(1)))
+ I X,X<LA7EDT(1) S LA7SRC=1
+ ;
+ ; Search "AN" cross-reference in file #69.
+ I LA7SRC D
+ . S LA7DT=LA7SDT(1)
+ . F  S LA7DT=$O(^LRO(69,LA7DT)) Q:'LA7DT!(LA7DT>LA7EDT(1))  D
+ . . S LA7ROOT="^LRO(69,LA7DT,1,""AN"")"
+ . . F  S LA7ROOT=$Q(@LA7ROOT) Q:LA7ROOT=""!($QS(LA7ROOT,2)'=LA7DT)!($QS(LA7ROOT,4)'="AN")  D
+ . . . I $QS(LA7ROOT,6)'=LRDFN Q
+ . . . S LRIDT=$QS(LA7ROOT,7)
+ . . . F LRSS="CH","MI","SP" D SEARCH
+ ;
+ ; If no orders in #69 then do long search through file #63.
+ I 'LA7SRC D
+ . F LRSS="CH","MI","SP" D
+ . . S LRIDT=0
+ . . F  S LRIDT=$O(^LR(LRDFN,LRSS,LRIDT)) Q:'LRIDT  D
+ . . . S LA763(0)=$G(^LR(LRDFN,LRSS,LRIDT,0))
+ . . . I $P(LA763(0),"^",3)>LA7SDT(1),$P(LA763(0),"^",3)<LA7EDT(1) D SEARCH
+ ;
+ Q
+ ;
+ ;
+SEARCH ; Search subscript for a specific collection date/time
+ ;
+ K LA763
+ S LA763(0)=$G(^LR(LRDFN,LRSS,LRIDT,0))
+ ;
+ ; Only CH, MI, and BB subscripts store pointer to file #61 in 5th piece of zeroth node.
+ ; Quit if specific specimen codes and they do not match
+ I "CHMIBB"[LRSS S LA761=+$P(LA763(0),"^",5)
+ E  S LA761=0
+ I LA761,$D(^TMP("LA7-61",$J)),'$D(^TMP("LA7-61",$J,LA761)) Q
+ ;
+ ; --- Chemistry
+ I LRSS="CH" D CHSS Q
+ ; --- Microbiology
+ I LRSS="MI" D MISS Q
+ ; --- Surgical pathology
+ I LRSS="SP" D APSS Q
+ ; --- Cytology
+ I LRSS="CY" D APSS Q
+ ; --- Electron Micrscopsy
+ I LRSS="EM" D APSS Q
+ ; --- Autopsy
+ I LRSS="AU" D APSS Q
+ ; --- Blood Bank
+ I LRSS="BB" D BBSS Q
+ Q
+ ;
+ ;
+CHSS ; Search "CH" datanames for matching codes
+ ;
+ N LA7X,LRSB
+ ;
+ S LRSB=1
+ F  S LRSB=$O(^LR(LRDFN,LRSS,LRIDT,LRSB)) Q:'LRSB  D
+ . S LA7X=$G(^LR(LRDFN,LRSS,LRIDT,LRSB))
+ . I $D(^AUPNVLAB) D LNCHK^C0CLA7Q ; WV check for IHS.
+ . S LA7CODE=$$DEFCODE^LA7VHLU5(LRSS,LRSB,$P(LA7X,"^",3),LA761)
+ . D CHECK
+ ;
+ Q
+ ;
+ ;
+MISS ; Search "MI" subscripts for matching codes
+ ;
+ N LA7ND,LRSB
+ ;
+ S LA7ND=0
+ F LA7ND=1,5,8,11,16 I $D(^LR(LRDFN,LRSS,LRIDT,LA7ND)) D
+ . S LRSB=$S(LA7ND=1:11,LA7ND=5:14,LA7ND=8:18,LA7ND=11:22,LA7ND=16:33,1:11)
+ . S LA7CODE=$$DEFCODE^LA7VHLU5(LRSS,LRSB,"",LA761)
+ . D CHECK
+ Q
+ ;
+ ;
+APSS ; Search AP subscripts for matching codes
+ ; AP results are currently not coded - use defaults
+ ;
+ N LA7CODE,LRSB
+ ;
+ S LRSB=.012
+ S LA7CODE=$$DEFCODE^LA7VHLU5(LRSS,LRSB,"","")
+ D CHECK
+ ;
+ Q
+ ;
+ ;
+BBSS ; Search BB subscript for matching codes
+ ; *** This subscript currently not supported ***
+ Q
+ ;
+ ;
+CHECK ; Check NLT order/result and LOINC codes.
+ ;
+ N LA7QUIT
+ ;
+ ; If wildcard then store
+ ; Otherwise check for specific NLT order/result and LOINC codes
+ I LA7SC="*" D STORE Q
+ S LA7QUIT=0
+ F I=1:1:3 D  Q:LA7QUIT
+ . ; If no test code then skip
+ . I '$L($P(LA7CODE,"!",I)) Q
+ . ; If test code does not match a search code then quit
+ . I '$D(^TMP($S(I=3:"LA7-LN",1:"LA7-NLT"),$J,$P(LA7CODE,"!",I))) Q
+ . D STORE S LA7QUIT=1
+ ;
+ Q
+ ;
+ ;
+STORE ; Store entry for building in HL7 message
+ ;
+ S ^TMP("LA7-QRY",$J,LRDFN,LRIDT,LRSS,LA7CODE,LRSB)=""
+ Q
+ ;
+ ;
+SETDFN(LA7X) ; Setup DFN and other lab variables.
+ ;
+ S DFN=LA7X,LRDFN=$P($G(^DPT(DFN,"LR")),"^")
+ Q
Index: /ccr/trunk/p/C0CRIMA.m
===================================================================
--- /ccr/trunk/p/C0CRIMA.m	(revision 507)
+++ /ccr/trunk/p/C0CRIMA.m	(revision 508)
@@ -1,4 +1,4 @@
-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,5 +37,5 @@
  ;
  ;
-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,5 +108,5 @@
     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,10 +150,10 @@
     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,5 +169,5 @@
     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,5 +205,5 @@
     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,5 +230,5 @@
  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,5 +252,5 @@
     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,5 +264,5 @@
     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,5 +276,5 @@
     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,5 +292,5 @@
     Q
     ;
-PATC(DFN) ; DISPLAY THE CATEGORY FOR THIS PATIENT
+PATC(DFN)	; DISPLAY THE CATEGORY FOR THIS PATIENT
     ;
     N ATTR S ATTR=""
@@ -305,5 +305,5 @@
     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,5 +320,5 @@
     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,5 +327,5 @@
       Q
       ;
-AINIT ; INITIALIZE ATTRIBUTE TABLE
+AINIT	; INITIALIZE ATTRIBUTE TABLE
       I '$D(RIMBASE) D ASETUP ; FOR COMMAND LINE CALLS
       K @RIMTBL
@@ -358,5 +358,5 @@
       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,5 +369,5 @@
     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,5 +392,5 @@
     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,5 +400,5 @@
     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,5 +406,5 @@
     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,5 +431,5 @@
     Q
     ;
-DCPAT(CATTR) ; DISPLAY LIST OF PATIENTS WITH ATTRIBUTE CATTR
+DCPAT(CATTR)	; DISPLAY LIST OF PATIENTS WITH ATTRIBUTE CATTR
     ;
     N ZR
@@ -442,5 +442,5 @@
     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,5 +460,5 @@
  Q
  ;
-ZGVWRK(ZWHICH) ; DO ONE SECTION FOR RPCGV
+ZGVWRK(ZWHICH)	; DO ONE SECTION FOR RPCGV
     ;
     N ZZGN ; NAME FOR SECTION VARIABLES
@@ -477,5 +477,5 @@
     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,5 +488,5 @@
     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,5 +514,5 @@
  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
Index: /ccr/trunk/p/C0CRNF.m
===================================================================
--- /ccr/trunk/p/C0CRNF.m	(revision 507)
+++ /ccr/trunk/p/C0CRNF.m	(revision 508)
@@ -1,4 +1,4 @@
-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,5 +22,5 @@
  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,5 +44,5 @@
  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,5 +70,5 @@
  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,5 +134,5 @@
  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,5 +198,5 @@
  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,5 +232,5 @@
  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,5 +238,5 @@
  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,5 +251,5 @@
  Q
  ;
-NV(RNRTN,RNIN) ;
+NV(RNRTN,RNIN)	;
  S RNR=$NA(@RNIN@("F"))
  S RNC=$NA(@RNIN@("V"))
@@ -273,5 +273,5 @@
  Q
  ;
-VN(RNRTN,RNIN) ;
+VN(RNRTN,RNIN)	;
  S RNR=$NA(@RNIN@("V"))
  S RNC=$NA(@RNIN@("F"))
@@ -295,5 +295,5 @@
  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,10 +308,10 @@
  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,5 +321,5 @@
  Q C0CF
  ;
-SKIP ;
+SKIP	;
  N TXT,DIERR
  S TXT=$$GET1^DIQ(8925,TIUIEN,"2","","TXT")
@@ -332,15 +332,15 @@
  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,5 +348,5 @@
  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
Index: /ccr/trunk/p/C0CRXN.m
===================================================================
--- /ccr/trunk/p/C0CRXN.m	(revision 507)
+++ /ccr/trunk/p/C0CRXN.m	(revision 508)
@@ -1,4 +1,4 @@
-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,5 +22,5 @@
  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,5 +83,5 @@
  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,5 +158,5 @@
  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,5 +253,5 @@
  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,5 +263,5 @@
  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,5 +271,5 @@
  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,5 +280,5 @@
  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
Index: /ccr/trunk/p/C0CSUB1.m
===================================================================
--- /ccr/trunk/p/C0CSUB1.m	(revision 507)
+++ /ccr/trunk/p/C0CSUB1.m	(revision 508)
@@ -1,4 +1,4 @@
-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,5 +21,5 @@
  Q
  ;
-CHK1(DFN) ; ADD THE CHECKSUM FOR ONE PATIENT
+CHK1(DFN)	; ADD THE CHECKSUM FOR ONE PATIENT
  ;
  S C0CCHK=$NA(^TMP("C0CRIM","CHKSUM"))
@@ -43,5 +43,5 @@
  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,5 +51,5 @@
  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,5 +66,5 @@
  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,5 +77,5 @@
  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,5 +99,5 @@
  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,5 +109,5 @@
  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,5 +117,5 @@
  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,5 +126,5 @@
  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
Index: /ccr/trunk/p/C0CSYS.m
===================================================================
--- /ccr/trunk/p/C0CSYS.m	(revision 507)
+++ /ccr/trunk/p/C0CSYS.m	(revision 508)
@@ -1,4 +1,4 @@
-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,33 +27,33 @@
  ; 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
+  ;
Index: /ccr/trunk/p/C0CUNIT.m
===================================================================
--- /ccr/trunk/p/C0CUNIT.m	(revision 507)
+++ /ccr/trunk/p/C0CUNIT.m	(revision 508)
@@ -1,4 +1,4 @@
-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,5 +22,5 @@
           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,5 +45,5 @@
           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,5 +68,5 @@
           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,5 +104,5 @@
           Q
           ;
-TEST   ; RUN ALL THE TEST CASES
+TEST	  ; RUN ALL THE TEST CASES
           N ZTMP
           D ZLOAD(.ZTMP)
@@ -115,5 +115,5 @@
           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,5 +122,5 @@
           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,5 +141,5 @@
           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,5 +155,5 @@
           Q
           ;
-MEDS
+MEDS	
  N DEBUG S DEBUG=0
  N DFN S DFN=5685
@@ -172,5 +172,5 @@
  D FILEOUT^C0CRNF(OUTXML,"TESTMEDS.xml")
  Q
-PAT
+PAT	
  D ANALYZE^ARJTXRD("C0CDPT",.OUT) ; Analyze a routine in the directory
  N X,Y
Index: /ccr/trunk/p/C0CUTIL.m
===================================================================
--- /ccr/trunk/p/C0CUTIL.m	(revision 507)
+++ /ccr/trunk/p/C0CUTIL.m	(revision 508)
@@ -1,132 +1,132 @@
 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
Index: /ccr/trunk/p/C0CVA200.m
===================================================================
--- /ccr/trunk/p/C0CVA200.m	(revision 507)
+++ /ccr/trunk/p/C0CVA200.m	(revision 508)
@@ -1,4 +1,4 @@
-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,152 +17,152 @@
  ;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)
+  ;
Index: /ccr/trunk/p/C0CVITAL.m
===================================================================
--- /ccr/trunk/p/C0CVITAL.m	(revision 507)
+++ /ccr/trunk/p/C0CVITAL.m	(revision 508)
@@ -1,4 +1,4 @@
-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,5 +22,5 @@
  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,5 +191,5 @@
  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
Index: /ccr/trunk/p/C0CVOBX1.m
===================================================================
--- /ccr/trunk/p/C0CVOBX1.m	(revision 508)
+++ /ccr/trunk/p/C0CVOBX1.m	(revision 508)
@@ -0,0 +1,114 @@
+LA7VOBX1 ;DALOI/JMC - LAB OBX Segment message builder (CH subscript) cont'd; 04/21/09
+ ;;5.2;AUTOMATED LAB INSTRUMENTS;**46,61,63**;Sep 27, 1994
+ ; JMC - mods to check for IHS V LAB file
+ ;
+CH ; Observation/Result segment for "CH" subscript results.
+ ; Called by LA7VOBX
+ ;
+ N LA76304,LA7ALT,LA7DIV,LA7I,LA7X,LA7Y,X
+ ;
+ ; "CH" subscript requires a dataname
+ I '$G(LRSB) Q
+ ;
+ ; get result node from LR global.
+ S LA76304(0)=$G(^LR(LRDFN,LRSS,LRIDT,0))
+ S LA7VAL=$G(^LR(LRDFN,LRSS,LRIDT,LRSB))
+ ;
+ ; Check if test is OK to send - (O)utput or (B)oth
+ S LA7X=$P(LA7VAL,"^",12)
+ I LA7X]"","BO"'[LA7X Q
+ I LA7X="",'$$OKTOSND^LA7VHLU1(LRSS,LRSB,+$P($P(LA7VAL,"^",3),"!",5)) Q
+	;
+	; If no result NLT or LOINC try to determine from file #60
+	S LA7X=$P(LA7VAL,"^",3)
+	; WV check for IHS - NLT/LN codes from V LAB file
+	I $D(^AUPNVLAB) D TMPCHK^C0CLA7Q
+	;
+	I $P(LA7X,"!",2)=""!($P(LA7X,"!",3)="") S $P(LA7VAL,"^",3)=$$DEFCODE^LA7VHLU5(LRSS,LRSB,LA7X,$P(LA76304(0),"^",5))
+	; No result NLT code - log error
+ I $P($P(LA7VAL,"^",3),"!",2)="" D
+ . N LA7X
+ . S LA7X="["_LRSB_"]"_$$GET1^DID(63.04,LRSB,"","LABEL")
+ . D CREATE^LA7LOG(36)
+ ;
+ ; something missing - No NLT code, etc.
+ I LA7VAL="" Q
+ ;
+ ; Check for missing units/reference ranges
+ S LA7X=$P(LA7VAL,"^",5)
+ ;
+ ; Results missing units, lookup in file #60
+ I $P(LA7X,"!",7)="" S $P(LA7X,"!",7)=$P($$REFUNIT^LA7VHLU1(LRSB,$P(LA76304(0),"^",5)),"^",3)
+ ;
+ ; If results missing reference ranges, use values from file #60.
+ I $P(LA7X,"!",2)="",$P(LA7X,"!",3)="",$P(LA7X,"!",11)="",$P(LA7X,"!",12)="" D
+ . S LA7Y=$$REFUNIT^LA7VHLU1(LRSB,$P(LA76304(0),"^",5))
+ . S $P(LA7X,"!",2)=$P(LA7Y,"^")
+ . S $P(LA7X,"!",3)=$P(LA7Y,"^",2)
+ . S $P(LA7X,"!",11)=$P(LA7Y,"^",6)
+ . S $P(LA7X,"!",12)=$P(LA7Y,"^",7)
+ ; Use therapeutic low/high if low/high missing.
+ I $P(LA7X,"!",2)="",$P(LA7X,"!",3)="" D
+ . S $P(LA7X,"!",2)=$P(LA7X,"!",11)
+ . S $P(LA7X,"!",3)=$P(LA7X,"!",12)
+ ;
+ ; Evaluate low/high reference ranges in case M code in these fields.
+ S:$G(SEX)="" SEX="M" S:$G(AGE)="" AGE=99
+ F LA7I=2,3 I $E($P(LA7X,"!",LA7I),1,3)="$S(" D
+ . S @("X="_$P(LA7X,"!",LA7I))
+ . S $P(LA7X,"!",LA7I)=X
+ ;
+ ; Put units/reference ranges back in variable LA7VAL
+ S $P(LA7VAL,"^",5)=LA7X
+ ;
+ ; Initialize OBX segment
+ S LA7OBX(0)="OBX"
+ S LA7OBX(1)=$$OBX1^LA7VOBX(.LA7OBXSN)
+ ;
+ ; Value type
+ S LA7OBX(2)=$$OBX2^LA7VOBX(63.04,LRSB)
+ ;
+ ; Observation identifer
+ ; build alternate code based on dataname from file #63 in case it's needed
+ S LA7X=$P(LA7VAL,"^",3)
+ S LA7ALT="CH"_LRSB_"^"_$$GET1^DID(63.04,LRSB,"","LABEL")_"^"_"99VA63"
+ S LA7OBX(3)=$$OBX3^LA7VOBX($P(LA7X,"!",2),$P(LA7X,"!",3),LA7ALT,LA7FS,LA7ECH)
+ ;
+ ; Test value
+ S LA7OBX(5)=$$OBX5^LA7VOBX($P(LA7VAL,"^"),LA7OBX(2),LA7FS,LA7ECH)
+ ;
+ ; Units - remove leading and trailing spaces
+ S LA7X=$P(LA7VAL,"^",5),LA7X=$$TRIM^XLFSTR(LA7X,"LR"," ")
+ S LA7OBX(6)=$$OBX6^LA7VOBX($P(LA7X,"!",7),"",LA7FS,LA7ECH)
+ ;
+ ; Reference range
+ S LA7OBX(7)=$$OBX7^LA7VOBX($P(LA7X,"!",2),$P(LA7X,"!",3),LA7FS,LA7ECH)
+ ;
+ ; Abnormal flags
+ S LA7OBX(8)=$$OBX8^LA7VOBX($P(LA7VAL,U,2))
+ ;
+ ; "P"artial or "F"inal results
+ S LA7OBX(11)=$$OBX11^LA7VOBX($S("canccommentpending"[$P(LA7VAL,"^"):$P(LA7VAL,"^"),1:"F"))
+ ;
+ ; Observation date/time - collection date/time per HL7 standard
+ I $P(LA76304(0),"^") S LA7OBX(14)=$$OBX14^LA7VOBX($P(LA76304(0),"^"))
+ ;
+ S LA7DIV=$P(LA7VAL,"^",9)
+ I LA7DIV="",$$DIV4^XUSER(.LA7DIV,$P(LA7VAL,"^",4)) S LA7DIV=$O(LA7DIV(0))
+ ;
+ ; Facility that performed the testing
+ S LA7OBX(15)=$$OBX15^LA7VOBX(LA7DIV,LA7FS,LA7ECH)
+ ;
+ ; Person that verified the test
+ S LA7OBX(16)=$$OBX16^LA7VOBX($P(LA7VAL,"^",4),LA7DIV,LA7FS,LA7ECH)
+ ;
+ ; Observation method
+ S LA7X=$P($P(LA7VAL,"^",3),"!",4)
+ I LA7X S LA7OBX(17)=$$OBX17^LA7VOBX(LA7X,LA7FS,LA7ECH)
+ ;
+ ; Equipment entity identifier
+ I $L($P(LA7VAL,"^",11)) S LA7OBX(18)=$$OBX18^LA7VOBX($P(LA7VAL,"^",11),LA7FS,LA7ECH)
+ ;
+ D BUILDSEG^LA7VHLU(.LA7OBX,.LA7ARRAY,LA7FS)
+ ;
+ Q
Index: /ccr/trunk/p/C0CXPAT0.m
===================================================================
--- /ccr/trunk/p/C0CXPAT0.m	(revision 507)
+++ /ccr/trunk/p/C0CXPAT0.m	(revision 508)
@@ -1,4 +1,4 @@
-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.
Index: /ccr/trunk/p/C0CXPATH.m
===================================================================
--- /ccr/trunk/p/C0CXPATH.m	(revision 507)
+++ /ccr/trunk/p/C0CXPATH.m	(revision 508)
@@ -1,4 +1,4 @@
-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,5 +22,5 @@
  Q
  ;
-OUTPUT(OUTARY,OUTNAME,OUTDIR)   ; WRITE AN ARRAY TO A FILE
+OUTPUT(OUTARY,OUTNAME,OUTDIR)	  ; WRITE AN ARRAY TO A FILE
  ;
  N Y
@@ -30,5 +30,5 @@
  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,5 +38,5 @@
  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,5 +50,5 @@
  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,5 +57,5 @@
  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,5 +68,5 @@
  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,5 +83,5 @@
  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,5 +141,5 @@
  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,28 +163,28 @@
  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,5 +204,5 @@
  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,5 +210,5 @@
  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,5 +222,5 @@
  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,5 +242,5 @@
  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,5 +261,5 @@
  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,5 +287,5 @@
  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,5 +307,5 @@
  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,5 +318,5 @@
  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,5 +342,5 @@
  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,5 +354,5 @@
  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,9 +379,9 @@
  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,5 +421,5 @@
  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,10 +429,10 @@
  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,5 +460,5 @@
  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,5 +471,5 @@
  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,9 +487,9 @@
  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,5 +498,5 @@
  Q
  ;
-TLIST   ; LIST THE TESTS
+TLIST	  ; LIST THE TESTS
  N ZTMP
  D ZLOAD^C0CUNIT("ZTMP","C0CXPAT0")
Index: /ccr/trunk/p/LA7QRY1.m
===================================================================
--- /ccr/trunk/p/LA7QRY1.m	(revision 507)
+++ /ccr/trunk/p/LA7QRY1.m	(revision 508)
@@ -1,123 +1,123 @@
 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