Index: qrda/C0Q/trunk/p/C0QERTIM.m
===================================================================
--- qrda/C0Q/trunk/p/C0QERTIM.m	(revision 1437)
+++ qrda/C0Q/trunk/p/C0QERTIM.m	(revision 1438)
@@ -1,4 +1,4 @@
-C0QERTIM	; Time from admission to leaving a hospital location ;
-	;;0.1;C0Q;;;Build 27
+C0QERTIM	; Time from admission to leaving a hospital location ; 5/23/12 2:26pm
+	;;1.0;C0Q;;May 21, 2012;Build 43
 EN	;Get Location
 	S DIC=42,DIC(0)="AEMQ" D ^DIC I Y<1 G EXIT
@@ -56,3 +56,2 @@
 	K POP,D0,D1,DIFFDAY,MINUTES,MID,MEDIAN,PATIENT,^TMP($J)
 	Q
-	
Index: qrda/C0Q/trunk/p/C0QGMRAD.m
===================================================================
--- qrda/C0Q/trunk/p/C0QGMRAD.m	(revision 1437)
+++ qrda/C0Q/trunk/p/C0QGMRAD.m	(revision 1438)
@@ -1,4 +1,4 @@
 C0QGMRAD	;HIRMFO/RM,WAA-UTILITY TO GATHER PATIENT DATA ;1/15/98  13:47
-	;;4.0;Adverse Reaction Tracking;**2,10**;Mar 29, 1996;Build 27
+	;;1.0;C0Q;;May 21, 2012;Build 43
 EN1	; ENTRY TO GATHER PATIENT A/AR DATA
 	;INPUT VARIABLES:
Index: qrda/C0Q/trunk/p/C0QGMTSA.m
===================================================================
--- qrda/C0Q/trunk/p/C0QGMTSA.m	(revision 1437)
+++ qrda/C0Q/trunk/p/C0QGMTSA.m	(revision 1438)
@@ -1,4 +1,4 @@
 C0QGMTSA	; SLC/DLT,KER - Brief Adverse Reaction/Allergy ; 02/27/2002
-	;;2.7;Health Summary;**28,49**;Oct 20, 1995;Build 27
+	;;1.0;C0Q;;May 21, 2012;Build 43
 	;                 
 	; External References
Index: qrda/C0Q/trunk/p/C0QGMTSG.m
===================================================================
--- qrda/C0Q/trunk/p/C0QGMTSG.m	(revision 1437)
+++ qrda/C0Q/trunk/p/C0QGMTSG.m	(revision 1438)
@@ -1,4 +1,4 @@
 C0QGMTSG	; SLC/DLT,KER - Allergies ; 01/06/2003
-	;;2.7;Health Summary;**9,28,49,58**;Oct 20, 1995;Build 27
+	;;1.0;C0Q;;May 21, 2012;Build 43
 	;                 
 	; External References
Index: qrda/C0Q/trunk/p/C0QHF.m
===================================================================
--- qrda/C0Q/trunk/p/C0QHF.m	(revision 1437)
+++ qrda/C0Q/trunk/p/C0QHF.m	(revision 1438)
@@ -1,4 +1,4 @@
 C0QHF	; GPL - Health Factor Utility Routines ;9/02/11  17:05
-	;;0.1;C0Q;nopatch;noreleasedate;Build 27
+	;;1.0;C0Q;;May 21, 2012;Build 43
 	;Copyright 2011 George Lilly.  Licensed under the terms of the GNU
 	;General Public License See attached copy of the License.
Index: qrda/C0Q/trunk/p/C0QIMMUN.m
===================================================================
--- qrda/C0Q/trunk/p/C0QIMMUN.m	(revision 1437)
+++ qrda/C0Q/trunk/p/C0QIMMUN.m	(revision 1438)
@@ -1,10 +1,12 @@
-C0QIMMUN	;Prep Immunization Order data for HL7 Message creation ;
-	;;0.1;C0Q;nopatch;noreleasedate;Build 27
+C0QIMMUN	;Prep Immunization Order data for HL7 Message creation ; 5/23/12 5:40pm
+	;;1.0;C0Q;;May 21, 2012;Build 43
 	;  ^XTMP("C0QIMMUN",0)=purge date^create date
 	;  ^XTMP("C0QIMMUN",order_date,order#,item_name)=item_value
 	;  ^XTMP("C0QIMMUN","LASTORDR")=last order processed
+	; Changed by VEN/SMH to add timeout to the locks on May 23 2012
 FIND	; Find the next set of immunization orders
 	N X1,X2,X,%,%DT,%H,%T,NOW,ORDER,LASTORDR,SUBSC,DIR
 	S LASTORDR=+$G(^XTMP("C0QIMMUN","LASTORDR"))
+	N C0QFAIL S C0QFAIL=0 ; Lock fail flag
 	W !,"The ""Last Order"" from which to begin checking for Immunization orders is: ",LASTORDR
 	S DIR("A")="Do you want to reset that value"
@@ -15,5 +17,6 @@
 	. D:Y>0
 	. . S LASTORDR=+Y
-	. . L +^XTMP("C0QIMMUN")
+	. . L +^XTMP("C0QIMMUN"):0
+	. . E  S C0QFAIL=1 QUIT
 	. . S X1=DT,X2=365 D C^%DTC
 	. . S ^XTMP("C0QIMMUN",0)=X_U_DT
@@ -22,7 +25,9 @@
 	. . Q
 	. Q
+	I C0QFAIL W !,"Failed to acquire lock, exiting..." QUIT
 	S DIR("A")="Ready to prep more immunization orders for HL7 messages"
 	S DIR(0)="Y",DIR("B")="YES" D ^DIR Q:Y'=1
-	L +^XTMP("C0QIMMUN")
+	L +^XTMP("C0QIMMUN"):0
+	E  W !,"Failed to acquire lock; exiting..." QUIT
 	I '$D(^XTMP("C0QIMMUN",0)) D
 	. S X1=DT,X2=365 D C^%DTC
Index: qrda/C0Q/trunk/p/C0QINIT.m
===================================================================
--- qrda/C0Q/trunk/p/C0QINIT.m	(revision 1437)
+++ qrda/C0Q/trunk/p/C0QINIT.m	(revision 1438)
@@ -1,72 +1,72 @@
-C0QINIT ; GPL - Quality Reporting Initialization Routines ;12/01/11  17:05
- ;;0.1;C0Q;nopatch;noreleasedate;Build 27
- ;Copyright 2011 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.
- ;
- Q
- ;
-C0QQFN() Q 1130580001.101 ; FILE NUMBER FOR C0Q QUALITY MEASURE FILE
-C0QMFN() Q 1130580001.201 ; FILE NUMBER FOR C0Q MEASUREMENT FILE
-C0QMMFN() Q 1130580001.2011 ; FN FOR MEASURE SUBFILE
-C0QMMNFN() Q 1130580001.20111 ; FN FOR NUMERATOR SUBFILE
-C0QMMDFN() Q 1130580001.20112 ; FN FOR DENOMINATOR SUBFILE
-RLSTFN() Q 810.5 ; FN FOR REMINDER PATIENT LIST FILE
-RLSTPFN() Q 810.53 ; FN FOR REMINDER PATIENT LIST PATIENT SUBFILE
-C0QALFN() Q 1130580001.311 ; FILE NUMBER FOR C0Q PATIENT LIST PATIENT SUBFILE ;
- ;
-COPYQ ; INTERACTIVE COPY OF A QUALITY MEASURE
- N FN
- S FN=$$C0QQFN
- S DIC=FN,DIC(0)="AEMQ" D ^DIC
- I Y<1 Q  ; EXIT
- S C0QIEN=$P(Y,U)
- ;N G,ZWP
- D GETS^DIQ(FN,C0QIEN,"**","EI","G")
- M ZWP=G(FN,C0QIEN_",",.61)
- ; GET READY TO CREATE THE NEW COPY
- ; FIRST FIND OUT THE NEW NAME
- N QNAME
- S QNAME=G(FN,C0QIEN_",",.01,"E")
- S DIR(0)="F^3:240"
- S DIR("A")="New Measure Name"
- S DIR("B")=QNAME
- D ^DIR
- I Y="^" Q  ;
- N QNEW
- S QNEW=Y
- K C0QFDA
- N ZI S ZI=""
- F  S ZI=$O(G(FN,C0QIEN_",",ZI)) Q:ZI=""  D  ; FOR EACH FIELD
- . I ZI=.01 D  Q  ; THE NEW NAME
- . . S C0QFDA(FN,"+1,",.01)=QNEW ; NEW MEASURE NAME
- . I ZI=3.1 Q  ; SKIP THE COMPUTED FIELD
- . S C0QFDA(FN,"+1,",ZI)=G(FN,C0QIEN_",",ZI,"I")
- D UPDIE ; CREATE THE NEW RECORD
- S DIE=$$C0QQFN ; GET READY TO EDIT IT
- D EN^DIB ; EDIT THE NEW RECORD
- Q
- ;
-UPDIE ; INTERNAL ROUTINE TO CALL UPDATE^DIE AND CHECK FOR ERRORS
- K ZERR
- D CLEAN^DILF
- ZWR C0QFDA
- D UPDATE^DIE("","C0QFDA","","ZERR")
- I $D(ZERR) S ZZERR=ZZERR ; ZZERR DOESN'T EXIST, 
- ; INVOKE THE ERROR TRAP IF TASKED
- K C0QFDA
- Q
- ;
+C0QINIT	; GPL - Quality Reporting Initialization Routines ; 5/23/12 5:43pm
+	;;1.0;C0Q;;May 21, 2012;Build 43
+	;Copyright 2011 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.
+	;
+	Q
+	;
+C0QQFN()	Q 1130580001.101 ; FILE NUMBER FOR C0Q QUALITY MEASURE FILE
+C0QMFN()	Q 1130580001.201 ; FILE NUMBER FOR C0Q MEASUREMENT FILE
+C0QMMFN()	Q 1130580001.2011 ; FN FOR MEASURE SUBFILE
+C0QMMNFN()	Q 1130580001.20111 ; FN FOR NUMERATOR SUBFILE
+C0QMMDFN()	Q 1130580001.20112 ; FN FOR DENOMINATOR SUBFILE
+RLSTFN()	Q 810.5 ; FN FOR REMINDER PATIENT LIST FILE
+RLSTPFN()	Q 810.53 ; FN FOR REMINDER PATIENT LIST PATIENT SUBFILE
+C0QALFN()	Q 1130580001.311 ; FILE NUMBER FOR C0Q PATIENT LIST PATIENT SUBFILE ;
+	;
+COPYQ	; INTERACTIVE COPY OF A QUALITY MEASURE
+	N FN
+	S FN=$$C0QQFN
+	S DIC=FN,DIC(0)="AEMQ" D ^DIC
+	I Y<1 Q  ; EXIT
+	S C0QIEN=$P(Y,U)
+	;N G,ZWP
+	D GETS^DIQ(FN,C0QIEN,"**","EI","G")
+	M ZWP=G(FN,C0QIEN_",",.61)
+	; GET READY TO CREATE THE NEW COPY
+	; FIRST FIND OUT THE NEW NAME
+	N QNAME
+	S QNAME=G(FN,C0QIEN_",",.01,"E")
+	S DIR(0)="F^3:240"
+	S DIR("A")="New Measure Name"
+	S DIR("B")=QNAME
+	D ^DIR
+	I Y="^" Q  ;
+	N QNEW
+	S QNEW=Y
+	K C0QFDA
+	N ZI S ZI=""
+	F  S ZI=$O(G(FN,C0QIEN_",",ZI)) Q:ZI=""  D  ; FOR EACH FIELD
+	. I ZI=.01 D  Q  ; THE NEW NAME
+	. . S C0QFDA(FN,"+1,",.01)=QNEW ; NEW MEASURE NAME
+	. I ZI=3.1 Q  ; SKIP THE COMPUTED FIELD
+	. S C0QFDA(FN,"+1,",ZI)=G(FN,C0QIEN_",",ZI,"I")
+	D UPDIE ; CREATE THE NEW RECORD
+	S DIE=$$C0QQFN ; GET READY TO EDIT IT
+	D EN^DIB ; EDIT THE NEW RECORD
+	Q
+	;
+UPDIE	; INTERNAL ROUTINE TO CALL UPDATE^DIE AND CHECK FOR ERRORS
+	K ZERR
+	D CLEAN^DILF
+	ZWRITE C0QFDA
+	D UPDATE^DIE("","C0QFDA","","ZERR")
+	I $D(ZERR) S ZZERR=ZZERR ; ZZERR DOESN'T EXIST, 
+	; INVOKE THE ERROR TRAP IF TASKED
+	K C0QFDA
+	Q
+	;
Index: qrda/C0Q/trunk/p/C0QKIDS.m
===================================================================
--- qrda/C0Q/trunk/p/C0QKIDS.m	(revision 1438)
+++ qrda/C0Q/trunk/p/C0QKIDS.m	(revision 1438)
@@ -0,0 +1,102 @@
+C0QKIDS	; VEN/SMH - Kids Utilities for transporting C0Q data ; 5/24/12 3:53pm
+	;;1.0;C0Q;;May 21, 2012;Build 43
+	; Licensed under package license. See Documentation.
+	;
+	; PEPs: TRAN, POST
+	;
+TRAN	; Unified Transport; PEP
+	; D TRAN301  ; looks like I won't send that file over
+	D TRAN201
+	QUIT
+POST	; Unified Post; PEP
+	; D POST301  ; looks like I won't send that file over
+	D POST101
+	D POST201
+	QUIT
+	;
+	; << >>
+	;
+TRAN301	; Grab FDA for entire file C0Q PATIENT LIST and store in Transport Global; Private EP
+	N C0QIEN S C0QIEN=0 ; IEN walker
+	N C0QREF1 S C0QREF1=$NAME(^TMP("C0QOLD",$J)) ; Temporary Global Reference
+	N C0QREF2 S C0QREF2=$NAME(^TMP("C0QNEW",$J)) ; Temporary Global Reference
+	K @C0QREF1,@C0QREF2   ; Kill that
+	F  S C0QIEN=$O(^C0Q(301,C0QIEN)) Q:'+C0QIEN  D
+	. D GETS^DIQ(1130580001.301,C0QIEN_",","*","",C0QREF1) ; Load FDA's in there
+	. M @C0QREF2@(1130580001.301,"?+"_C0QIEN_",")=@C0QREF1@(1130580001.301,C0QIEN_",") ; Change IENs to ?+ IENs
+	M @XPDGREF@("C0Q","1130580001.301")=@C0QREF2  ; Put in Transport Global
+	K @C0QREF1,@C0QREF2  ; Remove
+	QUIT
+	;
+TRAN201	; Grab FDA for 201 C0Q MEASUREMENTS selected fields; Private EP
+	N C0QIEN S C0QIEN=0 ; IEN walker
+	N C0QREF1 S C0QREF1=$NAME(^TMP("C0QOLD",$J)) ; Temporary Global Reference
+	N C0QREF2 S C0QREF2=$NAME(^TMP("C0QNEW",$J)) ; Temporary Global Reference
+	K @C0QREF1,@C0QREF2   ; Kill that
+	;
+	; We need C0QCOUNT so that it wouldn't reuse the numbers, b/c updater wants numbers for every different item
+	N C0QCOUNT S C0QCOUNT=$O(^C0Q(201," "),-1) ; Counter for SubIENs for destination array; init at highest IEN to prevent dups
+	F  S C0QIEN=$O(^C0Q(201,C0QIEN)) Q:'+C0QIEN  D  ; Walk IENs
+	. W "Exporting "_C0QIEN,!
+	. ; Fields SET NAME, BEGIN DATE, END DATE, LOCKED, USE ALL MEASURES, MU YEAR KEY
+	. D GETS^DIQ(1130580001.201,C0QIEN_",",".01;.02;.03;.05;.2;.3","",C0QREF1)
+	. M @C0QREF2@(1130580001.201,"?+"_C0QIEN_",")=@C0QREF1@(1130580001.201,C0QIEN_",") ; Change IENs to ?+ IENs
+	. N C0QIEN2 S C0QIEN2=0 ; Subfile walker
+	. F  S C0QIEN2=$O(^C0Q(201,C0QIEN,5,C0QIEN2)) Q:'+C0QIEN2  D  ; MEASURE subfile
+	. . W "Exporting IENS "_C0QIEN2_","_C0QIEN_",",!
+	. . D GETS^DIQ(1130580001.2011,C0QIEN2_","_C0QIEN_",",".01","",C0QREF1) ; MEASURE (#.01)
+	. . S C0QCOUNT=C0QCOUNT+1 ; Increment the counter for SubIEN (can't reuse)
+	. . M @C0QREF2@(1130580001.2011,"?+"_C0QCOUNT_","_"?+"_C0QIEN_",")=@C0QREF1@(1130580001.2011,C0QIEN2_","_C0QIEN_",") ; as above
+	;
+	M @XPDGREF@("C0Q","1130580001.201")=@C0QREF2 ; Put in transport global
+	K @C0QREF1,@C0QREF2  ; Remove temp
+	QUIT
+	;
+POST201	; File FDA for 201; Private EP
+	IF $O(^C0Q(201,0)) DO  QUIT  ; Quit if data is already there.
+	. D MES^XPDUTL("Data exists in file C0Q MEASUREMENTS... Not adding new data")
+	;
+	D MES^XPDUTL("Adding data to C0Q MEASUREMENTS")
+	N C0QFDA S C0QFDA=$NAME(@XPDGREF@("C0Q","1130580001.201")) ; Grab FDA from Transport Global
+	N C0QERR ; Error array for filer
+	D UPDATE^DIE("E",C0QFDA,"","C0QERR") ; File all
+	I $D(C0QERR) D  ; if there's an error, print it out
+	. D MES^XPDUTL("Couldn't add data into C0Q MEASUREMENTS")
+	. S C0QERR=$Q(C0QERR)
+	. F  S C0QERR=$Q(@C0QERR) Q:C0QERR=""  D MES^XPDUTL(C0QERR_": "_@C0QERR)
+	QUIT
+	;
+POST301	; Get FDA from Transport Global and install in destination system for C0Q PATIENT LIST; Private EP
+	N C0QFDA S C0QFDA=$NAME(@XPDGREF@("C0Q","1130580001.301")) ; FDA array name is the global reference
+	N C0QERR ; Error 
+	D UPDATE^DIE("E",C0QFDA,"","C0QERR") ; File all
+	I $D(C0QERR) D  ; if there's an error, print it out
+	. D MES^XPDUTL("Couldn't add data into C0Q PATIENT LIST file")
+	. S C0QERR=$Q(C0QERR)
+	. F  S C0QERR=$Q(@C0QERR) Q:C0QERR=""  D MES^XPDUTL(C0QERR_": "_@C0QERR)
+	QUIT
+	;
+POST101	; Clean transported data from broken pointers in C0Q QUALITY MEASURE in destination systems; Private EP
+	D MES^XPDUTL("Cleaning C0Q QUALITY MEASURE data")
+	N C0QIEN S C0QIEN=0 ; Ien looper
+	N C0QFDA ; Fileman Data Array
+	F  S C0QIEN=$O(^C0Q(101,C0QIEN)) Q:'+C0QIEN  DO  ; For each record, delete these fields
+	. S C0QFDA(1130580001.101,C0QIEN_",",1)="@" ; NUMERATOR PATIENT LIST
+	. S C0QFDA(1130580001.101,C0QIEN_",",1.5)="@" ; NEGATIVE NUMERATOR LIST
+	. S C0QFDA(1130580001.101,C0QIEN_",",2)="@" ; DENOMINATOR PATIENT LIST
+	. ; ---
+	. ; I wasn't planning on emptying these out, but the IENs in desintation systems may be different
+	. ; so it is best to remove them for now. It's a pointer field, so IENs are important.
+	. ; Desination file is populated automatically, but only at the site, and only after config.
+	. ; So we can't really ship the pointers as part of the install.
+	. ; ---
+	. S C0QFDA(1130580001.101,C0QIEN_",",1.1)="@" ; ALTERNATIVE NUMERATOR LIST
+	. S C0QFDA(1130580001.101,C0QIEN_",",1.51)="@" ; ALTERNATE NEGATIVE NUM LIST
+	. S C0QFDA(1130580001.101,C0QIEN_",",2.1)="@" ; ALTERNATIVE DENOMINATOR LIST
+	N C0QERR ; Errors
+	D FILE^DIE("","C0QFDA","C0QERR") ; Do it!
+	I $D(C0QERR) D  ; if there's an error, print it out
+	. D MES^XPDUTL("Couldn't fix data into C0Q QUALITY MEASURE file")
+	. S C0QERR=$Q(C0QERR)
+	. F  S C0QERR=$Q(@C0QERR) Q:C0QERR=""  D MES^XPDUTL(C0QERR_": "_@C0QERR)
+	QUIT
Index: qrda/C0Q/trunk/p/C0QMAIN.m
===================================================================
--- qrda/C0Q/trunk/p/C0QMAIN.m	(revision 1437)
+++ qrda/C0Q/trunk/p/C0QMAIN.m	(revision 1438)
@@ -1,4 +1,4 @@
 C0QMAIN	; GPL - Quality Reporting Main Processing ;10/13/10  17:05
-	;;0.1;C0Q;nopatch;noreleasedate;Build 27
+	;;1.0;C0Q;;May 21, 2012;Build 43
 	;Copyright 2009 George Lilly.  Licensed under the terms of the GNU
 	;General Public License See attached copy of the License.
Index: qrda/C0Q/trunk/p/C0QMU12.m
===================================================================
--- qrda/C0Q/trunk/p/C0QMU12.m	(revision 1437)
+++ qrda/C0Q/trunk/p/C0QMU12.m	(revision 1438)
@@ -1,996 +1,996 @@
-C0QPRML ;JJOH/ZAG/GPL - Patient Reminder List ;7/5/11 8:50pm
- ;;1.0;MU PACKAGE;;;Build 27
- ;
- ;2011 Zach Gonzales<zach@linux.com> - 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.
- ;
- ; GPL - THIS ROUTINE IS A COPY OF JJOHMU11 THAT HAS BEEN MODIFIED
- ; FOR MEANINGFUL USE CALCULATION FOR FISCAL YEAR 2012 AT OROVILLE HOSPITAL
- ;
-C0QPFN() Q 1130580001.401 ; PARAMETER FILE
-C0QPCFN() Q 1130580001.411 ; CLINIC SUBFILE
-C0QMFN() Q 1130580001.201 ; FILE NUMBER FOR C0Q MEASUREMENT FILE
-C0QMMFN() Q 1130580001.2011 ; FN FOR MEASURE SUBFILE
-INIT(ZARY,ZTYP) ; INITIALIZE THE PARAMETERS FOR BUILDING PATIENT LISTS
- ; ZARY IS PASSED BY NAME
- ; ZTYP IS "INP" OR "EP"
- N ZMU S ZMU="MU12" ; THIS IS THE ONLY HARD CODED VALUE LEFT
- ; TBD - CHANGE IT TO A READ FROM SYSTEM PARAMETERS
- K @ZARY ; CLEAR RETURN ARRAY
- N ZIEN,ZCNT,ZX
- I $O(^C0Q(401,"MUTYP",ZMU,ZTYP,""))="" D  Q  ; OOPS NO RECORD THERE
- . W !,"ERROR, NO PARAMETERS AVAILABLE"
- S ZIEN=""
- S ZCNT=0
- F  S ZIEN=$O(^C0Q(401,"MUTYP",ZMU,ZTYP,ZIEN)) Q:ZIEN=""  D  ;
- . S ZCNT=ZCNT+1
- . S @ZARY@(ZCNT,"MU")=$$GET1^DIQ($$C0QPFN,ZIEN_",",.02)
- . S @ZARY@(ZCNT,"TYPE")=$$GET1^DIQ($$C0QPFN,ZIEN_",",.03)
- . S ZX=$$GET1^DIQ($$C0QPFN,ZIEN_",",1,"I")
- . S @ZARY@(ZCNT,"InpatientMeasurementSet")=ZX
- . S @ZARY@(ZCNT,"InpatientBeginDate")=$$GET1^DIQ($$C0QMFN,ZX_",",.02,"I")
- . S @ZARY@(ZCNT,"InpatientEndDate")=$$GET1^DIQ($$C0QMFN,ZX_",",.03,"I")
- . S @ZARY@(ZCNT,"InpatientQualitySet")=$$GET1^DIQ($$C0QPFN,ZIEN_",",1.1,"I")
- . S ZX=$$GET1^DIQ($$C0QPFN,ZIEN_",",2,"I")
- . S @ZARY@(ZCNT,"EPMeasurementSet")=ZX
- . S @ZARY@(ZCNT,"EPBeginDate")=$$GET1^DIQ($$C0QMFN,ZX_",",.02,"I")
- . S @ZARY@(ZCNT,"EPEndDate")=$$GET1^DIQ($$C0QMFN,ZX_",",.03,"I")
- . S @ZARY@(ZCNT,"EPQualitySet")=$$GET1^DIQ($$C0QPFN,ZIEN_",",2.1,"I")
- . S @ZARY@(ZCNT,"InpatientQualitySet")=$$GET1^DIQ($$C0QPFN,ZIEN_",",1.1,"I")
- . D CLEAN^DILF
- . D LIST^DIC($$C0QPCFN,","_ZIEN_",",".01I")
- . I $D(^TMP("DIERR",$J)) D  Q  ; ERROR READING CLINIC LIST
- . . W !,"ERROR READING CLINIC PARAMETER LIST"
- . M @ZARY@(ZCNT,"CLINICS")=^TMP("DILIST",$J)
- ;
- Q
- ;
-BUILD ; CALL ALL AND DIS AND BUILD THE GRSLT ARRAY or print or create
- ; patient lists
- ;N GRSLT ; ARRAY FOR RESULTS
- I '$D(C0QSS) S C0QSS=0 ;default don't build spreadsheet array
- I '$D(C0QPR) S C0QPR=0 ;default don't print out results
- I '$D(C0QPL) S C0QPL=1 ;default do create patient lists
- S ZYR="MU12-"
- D INITCLST ; initialize C0QLIST
- N G1 ; ONE SET OF VALUES - RNF1 FORMAT
- N C0QPARM
- D INIT("C0QPARM","INP") ; initialize inpatient parms
- I $O(C0QPARM(""))="" D  Q  ; no parms for inpatient
- . W !,"No inpatient parameters"
- N ZDIV S ZDIV=""
- F  S ZDIV=$O(C0QPARM(ZDIV)) Q:ZDIV=""  D  ; for each inpatient division
- . D ALL ; all currently admitted patients in the hospital
- . D DIS ; all patients discharged since the reporting period began
- . I C0QSS ZWR GRSLT
- . ;D ICUPAT ; GENERATE ICU PATIENT LIST
- . I C0QPL D  ;
- . . D FILE ; FILE THE PATIENT LISTS
- . . D UPDATE^C0QUPDT(.G,C0QPARM(ZDIV,"InpatientMeasurementSet")) ; 
- . . D UPDATE^C0QUPDT(.G,C0QPARM(ZDIV,"InpatientQualitySet")) ; 
- . K C0QLIST
- Q
- ;
-INITCLST ; initialize C0QLIST
- ; INITIALIZE LISTS
- ; this is done so that if there are no matching patients, the patient list
- ; will be zeroed out
- K C0QLIST
- S C0QLIST(ZYR_"HasDemographics")=""
- S C0QLIST(ZYR_"Patient")=""
- S C0QLIST(ZYR_"HasProblem")=""
- S C0QLIST(ZYR_"HasAllergy")=""
- S C0QLIST(ZYR_"HasMed")=""
- S C0QLIST(ZYR_"HasVitalSigns")=""
- S C0QLIST(ZYR_"HasMedOrders")=""
- S C0QLIST(ZYR_"HasSmokingStatus")=""
- Q
- ;
-ALL ;retrieve active inpatients
- N WARD S WARD=""
- F  D  Q:WARD=""
- . S WARD=$O(^DIC(42,"B",WARD)) ;ward name
- . Q:WARD=""
- . N WIEN S WIEN=""
- . F  S WIEN=$O(^DIC(42,"B",WARD,WIEN)) Q:'WIEN  D  ;wards IEN
- . . S WARDNAME=$P(^DIC(42,WIEN,0),U,2) ;ward name
- . . N DFN,RB S DFN=""
- . . F  S DFN=$O(^DPT("CN",WARD,+DFN)) Q:'DFN  D  ;DFN of patient on ward
- . . . D DEMO
- . . . D PROBLEM
- . . . D ALLERGY
- . . . D MEDS4
- . . . D RECON2
- . . . D ADVDIR
- . . . D SMOKING
- . . . D VITALS
- . . . D VTE1
- . . . D COD
- . . . D EDTIME
- . . . I C0QPR D PRINT
- . . . I C0QSS D SS
- . . . I C0QPL D PATLIST
- Q
- ;
-DEMO ; patient demographics
- K PTDOB
- N PTNAME,PTSEX,PTHRN,PTRLANG,PTLANG,RACE,RACEDSC,ETHN,ETHNDSC,RB
- S PTNAME=$P(^DPT(DFN,0),U) ;patient name
- S PTDOB=$$FMTE^XLFDT($P($G(^DPT(DFN,0)),U,3)) ;date of birth
- S PTSEX=$P($G(^DPT(DFN,0)),U,2) ;patient sex
- D PID^VADPT ;VADPT call to grab PISD based on PT Eligibility
- S PTHRN=$P($G(VA("PID")),U) ;health record number
- S PTRLANG=$P($G(^DPT(DFN,256000)),U) ;ptr to language file
- I $G(PTRLANG)'="" S PTLANG=$P(^DI(.85,PTRLANG,0),U) ;PLS extrnl
- S RACE=""
- F  D  Q:RACE=""
- . S RACE=$O(^DPT(DFN,.02,"B",RACE)) ;race code IEN
- . Q:'RACE
- . S RACEDSC=$P($G(^DIC(10,RACE,0)),U) ;race description
- S ETHN=""
- F  D  Q:ETHN=""
- . S ETHN=$O(^DPT(DFN,.06,"B",ETHN)) ;ethnicity IEN
- . Q:'ETHN
- . S ETHNDSC=$P($G(^DIC(10.2,ETHN,0)),U) ;ethnincity description
- S RB=$P($G(^DPT(DFN,.101)),U) ;room and bed
- N DEMOYN S DEMOYN=1
- I $G(PTSEX)="" S DEMOYN=0
- I $G(PTDOB)="" S DEMOYN=0
- I $G(PTHRN)="" S DEMOYN=0
- I $G(PTLANG)="" S DEMOYN=0
- I $G(RACEDSC)="" S DEMOYN=0
- I $G(ETHNDSC)="" S DEMOYN=0
- I DEMOYN S C0QLIST(ZYR_"HasDemographics",DFN)=""
- E  S C0QLIST(ZYR_"FailedDemographics",DFN)=""
- Q
- ;
-PROBLEM ; PATIENT PROBLEMS
- D LIST^ORQQPL(.PROBL,DFN,"A")
- S PBCNT=""
- F  S PBCNT=$O(PROBL(PBCNT)) Q:PBCNT=""  D
- . S PBDESC=$P(PROBL(PBCNT),U,2) ;problem description
- I PBDESC["No problems found" S C0QLIST(ZYR_"NoProblem",DFN)=""
- E  S C0QLIST(ZYR_"HasProblem",DFN)=""
- K PROBL
- Q
- ; 
-ALLERGY ; ALLERGY LIST
- ; WANT TO CHANGE ALLERGIES FOR 2012 TO POPULATE THE C0QLIST DIRECTLY. GPL
- D LIST^ORQQAL(.ALRGYL,DFN)
- S ALCNT=""
- F  S ALCNT=$O(ALRGYL(ALCNT)) Q:ALCNT=""  D
- . S ALDESC=$P(ALRGYL(ALCNT),U,2) ;allergy description
- I ALDESC["No Allergy" S C0QLIST(ZYR_"NoAllergy",DFN)=""
- E  S C0QLIST(ZYR_"HasAllergy",DFN)=""
- K ALRGYL
- Q
- ;
-MEDS4 ; USE OCL^PSOORRL TO GET ALL MEDS
- ; DELETED MEDS, MEDS2, AND MEDS3 FOR 2012 TO USE ONLY MEDS4
- N BEG,END
- S BEG=$$DT^C0QUTIL("JULY 3,2011")
- S END=$$DT^C0QUTIL("NOW")
- D OCL^PSOORRL(DFN,BEG,END)  ;DBIA #2400
- N C0QMEDS
- M C0QMEDS=^TMP("PS",$J) ; MEDS RETURNED FROM CALL
- N FOUND
- N ZI
- I '$D(C0QMEDS(1)) D  Q  ; QUIT IF NO MEDS
- . S C0QLIST(ZYR_"NoMed",DFN)=""
- E  D  ; HAS MEDS
- . S C0QLIST(ZYR_"HasMed",DFN)=""  
- S ZI="" S FOUND=0
- F  S ZI=$O(C0QMEDS(ZI)) Q:ZI=""  D  ; FOR EACH MED
- . N ZM
- . S ZM=$G(C0QMEDS(ZI,0)) ;THE MEDICATION
- . I $P($P(ZM,"^",1),";",2)="I" D  ; IE 1U;I FOR AN INPATIENT UNIT DOSE
- . . S FOUND=1
- I FOUND S C0QLIST(ZYR_"HasMedOrders",DFN)="" ; MET CPOE MEASURE
- E  S C0QLIST(ZYR_"NoMedOrders",DFN)=""
- Q
- ;
-RECON ; MEDICATIONS RECONCILIATION
- ; WANT TO SIMPLIFY MEDS RECON FOR 2012. GPL
- ; 
- I $$HASNTYN^C0QNOTES("MED/SURG NURSING ADMISSION ASSESSMENT",DFN) D  ;
- . S C0QLIST(ZYR_"XferOfCare",DFN)="" ; transfer of care patient
- N HASRECON S HASRECON=0
- N GT,G
- S GT(4,"HasMedRecon","MEDICATION RECONCILIATION COMPLET")=""
- S GT(5,"HasMedRecon","Medication Reconcilation Complete")=""
- I $$TXTALL^C0QNOTES(.G,.GT,DFN) D  ; SEARCH ALL NOTES FOR MED RECON
- . S HASRECON=1
- ;N ZT
- ;S ZT="MEDICATION RECONCILIATION COMPLET"
- ;I $$NTTXT^C0QNOTES("ER NURSE NOTE",ZT,DFN) D  ;
- ;. S HASRECON=1
- ;E  D  ;
- ;. S ZT="Medication Reconcilation Complete"
- ;. I $$NTTXT^C0QNOTES("MED/SURG NURSING ADMISSION ASSESSMENT",ZT,DFN) D  ;
- ;. . S HASRECON=1
- ;I $$HFYN^C0QHF("MEDS HAVE BEEN REVIEWED",DFN) S HASRECON=1
- I HASRECON D  ;
- . S C0QLIST(ZYR_"HasMedRecon",DFN)=""
- E  S C0QLIST(ZYR_"NoMedRecon",DFN)=""
- Q
- ;
-RECON2 ; USE HEALTH FACTORS FOR MEDICATION RECONCILIATION
- I $$HASNTYN^C0QNOTES("MED/SURG NURSING ADMISSION ASSESSMENT",DFN) D  ;
- . S C0QLIST(ZYR_"XferOfCare",DFN)="" ; transfer of care patient
- I $$HFYN^C0QHF(DFN,"Medication Reconciliation Completed: Yes") D  ;
- . S C0QLIST(ZYR_"HasMedRecon",DFN)=""
- E  S C0QLIST(ZYR_"NoMedRecon",DFN)=""
- Q
- ;
-ERX ; FOR EP, WE LOOK AT ERX MEDS
- N ZI S ZI=""
- N ZERX S ZERX=$NA(^PS(55,DFN,"NVA"))
- F  S ZI=$O(@ZERX@(ZI)) Q:ZI=""  D  ;
- . ;B
- . I $G(@ZERX@(ZI,1,1,0))["E-Rx Web" D  ;
- . . S C0QLIST(ZYR_"HasMed",DFN)=""
- . . S C0QLIST(ZYR_"HasMedOrders",DFN)=""
- . . S C0QLIST(ZYR_"HasERX",DFN)=""
- . . S C0QLIST(ZYR_"HasMedRecon",DFN)=""
- . E  D  ;
- . . S C0QLIST(ZYR_"NoMed",DFN)=""
- . . S C0QLIST(ZYR_"NoMedOrders",DFN)=""
- . . S C0QLIST(ZYR_"NoERX",DFN)=""
- . . S C0QLIST(ZYR_"NoMedRecon",DFN)=""
- Q
- ;
-ADVDIR ; ADVANCE DIRECTIVE
- ;
- I $$AGE^C0QUTIL(DFN)>64 D  ; ONLY FOR PATIENTS 65 AND OLDER
- . S C0QLIST(ZYR_"Over65",DFN)=""
- . I $$HASNTYN^C0QNOTES("ADVANCE DIRECTIVE",DFN) D  ;
- . . S C0QLIST(ZYR_"HasAdvanceDirective",DFN)=""
- . E  D  ;
- . . S C0QLIST(ZYR_"NoAdvanceDirective",DFN)=""
- Q
- ;
-SMOKING ;
- ; WANT TO CHANGE SMOKING STATUS CHECKING FOR 2012 TO A SIMPLE SET OF
- ; HEALTH FACTORS. GPL
- I $$INLIST(ZYR_"HasSmokingStatus",DFN) D  Q  ; ALREADY HAS SMOKING STAT CHECK
- . S C0QLIST(ZYR_"HasSmokingStatus",DFN)=""
- . S C0QLIST(ZYR_"Over12",DFN)=""
- I $$INLIST(ZYR_"NoSmokingStatus",DFN) D  Q  ; ALREADY HAS SMOKING STATUS CHECK
- . S C0QLIST(ZYR_"NoSmokingStatus",DFN)=""
- . S C0QLIST(ZYR_"Over12",DFN)=""
- N C0QSMOKE,C0QSYN
- S C0QSYN=0
- I $$AGE^C0QUTIL(DFN)<13 Q  ; DON'T CHECK UNDER AGE 13
- D HFCAT^C0QHF(.C0QSMOKE,DFN,"TOBACCO") ; GET ALL HEALTH FACTORS FOR THE
- ; PATIENT IN THE CATEGORY OF TOBACCO
- I $D(C0QSMOKE) S C0QSYN=1
- S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Quit Smokeless Tobacco <1 Yr Ago")
- S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Quit Smokeless Tobacco > 20 Yrs Ago")
- S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Quit Smokeless Tobacco: 1-5 Yrs Ago")
- S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Quit Smokeless Tobacco: 10-20 Yrs Ago")
- S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Quit Smokeless Tobacco: 5-10 Yrs Ago")
- S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Quit Smoking")
- S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Quit Smoking < 1 Yr Ago")
- S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Quit Smoking > 20 Yrs Ago")
- S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Quit Smoking: 1-5 Yrs Ago")
- S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Quit Smoking: 10-20 Yrs Ago")
- S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Quit Smoking: 5-10 Yrs Ago")
- S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"PREVIOUS SMOKELESS TOBACCO USER")
- S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"PREVIOUS SMOKELESS: 1-5 YRS AGO")
- S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"PREVIOUS SMOKELESS: 10-20 YRS AGO")
- S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"PREVIOUS SMOKELESS: 5-10 YRS AGO")
- S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"PREVIOUS SMOKELESS: < 1 YR AGO")
- S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"PREVIOUS SMOKELESS: > 20 YRS AGO")
- S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"PREVIOUS SMOKER")
- S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"PREVIOUS SMOKER 10-20 YRS")
- S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"PREVIOUS SMOKER 20+ YRS")
- S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"PREVIOUS SMOKER < 1 YR")
- S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"PREVIOUS SMOKER < 1 YR AGO")
- S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"PREVIOUS SMOKER > 20 YRS AGO")
- S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"PREVIOUS SMOKER: 1-5 YRS")
- S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"PREVIOUS SMOKER: 1-5 YRS AGO")
- S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"PREVIOUS SMOKER: 10-20 YRS AGO")
- S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"PREVIOUS SMOKER: 5-10 YRS")
- S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"PREVIOUS SMOKER: 5-10 YRS AGO")
- S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"PREVIOUS SMOKELESS TOBACCO USER")
- S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"LIFETIME NON-SMOKER")
- S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Former Smokeless Tobacco User")
- S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Former Smoker")
- S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Former Smoker (PMH)")
- S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoke Exposure/2nd Hand Exposure")
- S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For 1-5 Yrs")
- S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For 10-20 Yrs")
- S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For 5-10 Yrs")
- S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For < 1 Yr")
- S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For > 20 Yrs")
- S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Tobacco User")
- S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for 1-5 Yrs")
- S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for 10-20 Yrs")
- S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for 5-10 Yrs")
- S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for < 1 Yr")
- S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for > 20 Yrs")
- S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoker (HPI)")
- S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoking (FMH)")
- S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoking (PMH)")
- S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoking Cessation (OPH)")
- S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"LIFETIME NON-SMOKER")
- S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Former Smokeless Tobacco User")
- S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Former Smoker")
- S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Former Smoker (PMH)")
- S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoke Exposure/2nd Hand Exposure")
- S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For 1-5 Yrs")
- S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For 10-20 Yrs")
- S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For 5-10 Yrs")
- S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For < 1 Yr")
- S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For > 20 Yrs")
- S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Tobacco User")
- S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for 1-5 Yrs")
- S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for 10-20 Yrs")
- S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for 5-10 Yrs")
- S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for < 1 Yr")
- S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for > 20 Yrs")
- S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoker (HPI)")
- S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoking (FMH)")
- S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoking (PMH)")
- S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Non-Smoker")
- S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"LIFETIME NON-SMOKER")
- S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Former Smokeless Tobacco User")
- S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Former Smoker")
- S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Former Smoker (PMH)")
- S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoke Exposure/2nd Hand Exposure")
- S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For 1-5 Yrs")
- S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For 10-20 Yrs")
- S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For 5-10 Yrs")
- S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For < 1 Yr")
- S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For > 20 Yrs")
- S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Tobacco User")
- S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for 1-5 Yrs")
- S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for 10-20 Yrs")
- S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for 5-10 Yrs")
- S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for < 1 Yr")
- S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for > 20 Yrs")
- S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoker (HPI)")
- S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoking (FMH)")
- S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoking (PMH)")
- S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"LIFETIME NON-SMOKER")
- S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Former Smokeless Tobacco User")
- S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Former Smoker")
- S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Former Smoker (PMH)")
- S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoke Exposure/2nd Hand Exposure")
- S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For 1-5 Yrs")
- S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For 10-20 Yrs")
- S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For 5-10 Yrs")
- S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For < 1 Yr")
- S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For > 20 Yrs")
- S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Tobacco User")
- S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for 1-5 Yrs")
- S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for 10-20 Yrs")
- S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for 5-10 Yrs")
- S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for < 1 Yr")
- S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for > 20 Yrs")
- S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoker (HPI)")
- S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoking (FMH)")
- S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoking (PMH)")
- S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Non-Smoker")
- S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"LIFETIME NON-SMOKER")
- S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Former Smokeless Tobacco User")
- S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Former Smoker")
- S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Former Smoker (PMH)")
- S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoke Exposure/2nd Hand Exposure")
- S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For 1-5 Yrs")
- S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For 10-20 Yrs")
- S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For 5-10 Yrs")
- S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For < 1 Yr")
- S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For > 20 Yrs")
- S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Tobacco User")
- S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for 1-5 Yrs")
- S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for 10-20 Yrs")
- S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for 5-10 Yrs")
- S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for < 1 Yr")
- S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for > 20 Yrs")
- S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoker (HPI)")
- S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoking (FMH)")
- S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoking (PMH)")
- S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Non-Smoker")
- S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Non-Smoker (PMH)")
- S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Non-Tobacco User")
- S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Current Smoker - No")
- S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Current Smoker - Yes")
- S C0QLIST(ZYR_"Over12",DFN)=""
- ;N GT
- ;S GT(1,"HasSmokingStatus","SMOK")=""
- ;S GT(2,"HasSmokingStatus","Smok")=""
- ;S GT(3,"HasSmokingStatus","smok")=""
- ;I 'C0QSYN D  ;
- ;. N G
- ;. S OK=$$TXTALL^C0QNOTES(.G,.GT,DFN)
- ;. I $D(G) S C0QSYN=1
- I C0QSYN S C0QLIST(ZYR_"HasSmokingStatus",DFN)=""
- E  S C0QLIST(ZYR_"NoSmokingStatus",DFN)=""
- Q
- ;
-VITALS ;
- ;
- N C0QSDT,C0QEDT
- D DT^DILF(,"JULY 3,2011",.C0QSDT) ; START DATE
- D DT^DILF(,"T",.C0QEDT) ; END DATE TODAY
- D VITALS^ORQQVI(.VITRSLT,DFN,C0QSDT,C0QEDT) ; CALL FAST VITALS
- I $D(VITRSLT) D  ;ZWR VITRSLT B  ;
- . I VITRSLT(1)["No vitals found." S C0QLIST(ZYR_"NoVitalSigns",DFN)=""
- . E  S C0QLIST(ZYR_"HasVitalSigns",DFN)=""
- Q
- ;
-VTE1 ; VTE PROPHYLAXIS WITHIN 24HRS OF ARRIVAL
- ;
- I $$HFYN^C0QHF(DFN,"VTE PROPHYLAXIS WITHIN 24HRS OF ARRIVAL") D  ;
- . S C0QLIST(ZYR_"HasVTE24",DFN)=""
- E  S C0QLIST(ZYR_"NoVTE24",DFN)="" 
- Q
- ;
-COD ; TEST FOR PRELIMINARY CAUSE OF DEATH NOTE
- I $$HASNTYN^C0QNOTES("PRELIMINARY CAUSE OF DEATH",DFN) D  ;
- . S C0QLIST(ZYR_"CauseOfDeath",DFN)=""
- Q
- ;
-EDTIME ; CHECK FOR EMERGENCY DEPT TIME FACTORS
- N FOUND
- S FOUND=0
- I $$HFYN^C0QHF(DFN,"ED ARRIVAL TIME") S FOUND=1
- I '$$HFYN^C0QHF(DFN,"ED DEPARTURE TIME") S FOUND=0
- I '$$HFYN^C0QHF(DFN,"TIME DECISION TO ADMIT MADE") S FOUND=0
- I FOUND D  ; 
- . S C0QLIST(ZYR_"HasEDtime",DFN)=""
- E  S C0QLIST(ZYR_"NoEDtime",DFN)=""
- Q
- ;
-ICUPAT ; CREATE LIST OF ICU PATIENTS
- N ZICU
- S ZICU=$O(^SC("B","IC","")) ; IEN OF ICU HOSPITAL LOCATION
- N ZI,ZJ,ZP
- S ZI=""
- F  S ZI=$O(^AUPNVSIT("AHL",ZICU,ZI)) Q:ZI=""  D  ; EACH DATE
- . S ZJ=""
- . F  S ZJ=$O(^AUPNVSIT("AHL",ZICU,ZI,ZJ)) Q:ZJ=""  D  ; EACH VISIT
- . . S ZP=$P(^AUPNVSIT(ZJ,0),"^",5) ; DFN
- . . S C0QLIST(ZYR_"ICUPatient",ZP)=""
- Q
- ;
-FILTER ; CALLED AFTER ALL THE PATIENT LISTS HAVE BEEN FILED
- ; WILL KILL C0QLIST AND CREATE DERIVATIVE PATIENT LISTS BY FILTERING
- K C0QLIST
- N ZPAT
- S ZPAT=$$PATLN(ZYR_"Patient") ; name of patient list of all patients admitted
- ; during the reporting period. used to filter other lists
- ;
- ; filter ICU patients against ZPAT
- N GN,GO,GF
- S GN=ZPAT
- S GO=$$PATLN(ZYR_"ICUPatient") ; all ICU patient
- S GF=$NA(C0QLIST(ZYR_"ICUReporting")) ; the filtered list destination
- D AND^C0QSET(GF,GN,GO) ; filter the list with the AND set operation
- ; 
- ; FILTER VTE-2 DENOMINATOR FOR QUALITY MEASURE
- ;
- S GN=$NA(C0QLIST(ZYR_"ICUReporting")) ; ICU patients admitted inside rpt period
- S GO=$$RPATLN("MU VTE-2 DENOM PL") ; TAXONOMY BASED DENOMENATOR
- S GF=$NA(C0QLIST(ZYR_"VTE2DEN")) ; NEW DENOMINATOR PL
- D AND^C0QSET(GF,GN,GO) ; filter the list with the AND set operation
- ;
- S GN=ZPAT
- S GO=$$RPATLN("MU VTE-3 DENOM PL") ; TAXONOMY BASED DENOMENATOR
- S GF=$NA(C0QLIST(ZYR_"VTE3DEN")) ; NEW DENOMINATOR PL
- D AND^C0QSET(GF,GN,GO) ; filter the list with the AND set operation
- ;
- S GN=ZPAT
- S GO=$$RPATLN("MU VTE-4 DENOM PL") ; TAXONOMY BASED DENOMENATOR
- S GF=$NA(C0QLIST(ZYR_"VTE4DEN")) ; NEW DENOMINATOR PL
- D AND^C0QSET(GF,GN,GO) ; filter the list with the AND set operation
- ;
- S GN=ZPAT
- S GO=$$RPATLN("MU VTE-5 DENOM PL") ; TAXONOMY BASED DENOMENATOR
- S GF=$NA(C0QLIST(ZYR_"VTE5DEN")) ; NEW DENOMINATOR PL
- D AND^C0QSET(GF,GN,GO) ; filter the list with the AND set operation
- ;
- D FILE ; FILE ALL THE PATIENT LISTS
- D UPDATE^C0QUPDT(.G,5) ; UPDATE THE HOS 2011 MEANINGFUL USE measure set
- Q
- ;
-ED1 ;
- S ZYR="MU12-"
- D DOTIME("ED DEPARTURE TIME")
- Q
- ;
-ED2 ;
- S ZYR="MU12-"
- D DOTIME2("TIME DECISION TO ADMIT MADE")
- Q
- ;
-DOTIME(ZHF) ; COMPUTE THE MEAN TIME IN THE ED FROM ARRIVAL TO DEPARTURE
- ; THIS IS A QUALITY MEASURE ED-1 FOR MEANINGFUL USE
- ; IT PRINTS A REPORT OF EACH PATIENT WITH THE ED TIMES RECORDED
- ; AND THEIR TIME. AT THE END IT PRINTS THE MEAN TIME
- N ZP
- S ZP=$$PATLN(ZYR_"HasEDtime") ; patient list name for patients to process
- S ZHFN=9000010.23 ; FILE NUMBER FOR V HEALTH FACTORS
- S ZVFN=9000010 ; VISIT FILE NUMBER
- K ZARY1,ZARY2
- N ZI S ZI=""
- S COUNT=0
- F  S ZI=$O(@ZP@(ZI)) Q:ZI=""  D  ; FOR EACH PATIENT
- . S COUNT=COUNT+1
- . N ZA,ZD
- . S ZA=$$VHFIEN^C0QHF(ZI,"ED ARRIVAL TIME") ; IEN OF ARRIVAL HEALTH FACTOR
- . S ZD=$$VHFIEN^C0QHF(ZI,ZHF) ; IEN OF DEPART HEALTH FACTOR
- . N ZAD,ZDD ; ARRIVAL DATE, DEPARTURE DATE
- . N ZAC,ZDC ; ARRIVAL COMMENT, DEPARTURE COMMENT 
- . ; THE COMMENT IS THE TIME XXYY
- . N OK,TMP
- . S TMP=$$GET1^DIQ(ZHFN,ZA_",",.03,"I") ; VISIT POINTER
- . S ZAD=$$GET1^DIQ(ZVFN,TMP_",",.01,"I") ; VISIT DATE
- . ;S ZAD=$P(^AUPNVHF(ZA,0),U,3) ; DATE IS PIECE 3
- . S TMP=$$GET1^DIQ(ZHFN,ZD_",",.03,"I") ; VISIT POINTER
- . S ZDD=$$GET1^DIQ(ZVFN,TMP_",",.01,"I") ; VISIT DATE
- . ;S ZDD=$$GET1^DIQ(ZHFN,ZD_",",1201,"I") ; EVENT DATE FIELD
- . ;S ZDD=$P(^AUPNVHF(ZD,0),U,3) ; DATE IS PIECE 3
- . ;S OK=$$GET1^DIQ(ZHFN,ZA_",",81101,"","ZAC") ; ARRIVAL TIME
- . S ZAC=$G(^AUPNVHF(ZA,811)) ; THE TIME
- . ;S OK=$$GET1^DIQ(ZHFN,ZD_",",81101,"","ZDC") ; DEPARTURE TIME
- . S ZDC=$G(^AUPNVHF(ZD,811)) ; DEPARTURE TIME
- . N ZT ; THE TIME DIFFERENCE BETWEEN THE DATES
- . W !,!,"PATIENT: ",ZI," ",$P(^DPT(ZI,0),U,1)
- . W !,"IN: ",$$FMTE^XLFDT(ZAD_"."_ZAC)," OUT: ",$$FMTE^XLFDT(ZDD_"."_ZDC)
- . S G1=($E(ZDC,1,2)*60)+($E(ZDC,3,4))
- . S G2=($E(ZAC,1,2)*60)+($E(ZAC,3,4))
- . I (ZDD-ZAD)>0 S G1=G1+(((ZDD-ZAD)*24)*60)
- . S GTOT=G1-G2
- . W !,"TIME: ",GTOT," ESTIMATED"
- . S ZT=$$DTDIFF^C0QUTIL(ZDD,ZDC,ZAD,ZAC) ; COMPUTE THE DIFFERENCE IN MINUTES
- . W !,"COMPUTED MINUTES: ",ZT
- . ;I ZT'=GTOT B  ; LET'S FIND OUT WHAT'S WRONG
- . I ZT<0 D  Q  ; SKIP PATIENTS WITH NEGATIVE TIMES
- . . W !,"****EXCLUDED****"
- . I ZT>400000 D  Q  ; THESE ARE ERRORS
- . . W !,"****EXCLUDED****"
- . S ZARY1(ZT,ZI)="" ; ARRAY ORDERED BY MINUTES OF PATIENTS
- N ZY,ZZ S ZY="" S ZZ=""
- N ZCOUNT S ZCOUNT=0
- F  S ZY=$O(ZARY1(ZY)) Q:ZY=""  D  ; FOR EACH TIME
- . F  S ZZ=$O(ZARY1(ZY,ZZ)) Q:ZZ=""  D  ; FOR EACH PATIENT WITH THIS TIME
- . . S ZCOUNT=ZCOUNT+1
- . . S ZARY2(ZCOUNT,ZY,ZZ)=""
- . . ;W !,ZCOUNT," PATIENT: ",ZZ," MINUTES: ",ZY
- N ZMID
- S ZMID=$P(ZCOUNT/2,".")
- W !,"NUMBER OF PATIENTS IN REPORT: ",ZCOUNT
- W !,"ED ARRIVAL TIME UNTIL ",ZHF
- W !,"MEDIAN TIME: ",$O(ZARY2(ZMID,""))
- Q
- ;
-DOTIME2(ZHF) ; COMPUTE THE MEAN TIME IN THE ED FROM ARRIVAL TO DEPARTURE
- ; THIS IS A QUALITY MEASURE ED-1 FOR MEANINGFUL USE
- ; IT PRINTS A REPORT OF EACH PATIENT WITH THE ED TIMES RECORDED
- ; AND THEIR TIME. AT THE END IT PRINTS THE MEAN TIME
- N ZP
- S ZP=$$PATLN(ZYR_"HasEDtime") ; patient list name for patients to process
- S ZHFN=9000010.23 ; FILE NUMBER FOR V HEALTH FACTORS
- S ZVFN=9000010 ; VISIT FILE NUMBER
- K ZARY1,ZARY2
- N ZI S ZI=""
- S COUNT=0
- F  S ZI=$O(@ZP@(ZI)) Q:ZI=""  D  ; FOR EACH PATIENT
- . S COUNT=COUNT+1
- . N ZA,ZD
- . ;S ZA=$$VHFIEN^C0QHF(ZI,"ED ARRIVAL TIME") ; IEN OF ARRIVAL HEALTH FACTOR
- . ;S ZD=$$VHFIEN^C0QHF(ZI,ZHF) ; IEN OF DEPART HEALTH FACTOR
- . S ZA=$$VHFIEN^C0QHF(ZI,ZHF) ; IEN OF DEPART HEALTH FACTOR
- . S ZD=$$VHFIEN^C0QHF(ZI,"ED DEPARTURE TIME") ; IEN OF ARRIVAL HEALTH FACTOR
- . N ZAD,ZDD ; ARRIVAL DATE, DEPARTURE DATE
- . N ZAC,ZDC ; ARRIVAL COMMENT, DEPARTURE COMMENT 
- . ; THE COMMENT IS THE TIME XXYY
- . N OK,TMP
- . S TMP=$$GET1^DIQ(ZHFN,ZA_",",.03,"I") ; VISIT POINTER
- . S ZAD=$$GET1^DIQ(ZVFN,TMP_",",.01,"I") ; VISIT DATE
- . ;S ZAD=$P(^AUPNVHF(ZA,0),U,3) ; DATE IS PIECE 3
- . S TMP=$$GET1^DIQ(ZHFN,ZD_",",.03,"I") ; VISIT POINTER
- . S ZDD=$$GET1^DIQ(ZVFN,TMP_",",.01,"I") ; VISIT DATE
- . ;S ZDD=$$GET1^DIQ(ZHFN,ZD_",",1201,"I") ; EVENT DATE FIELD
- . ;S ZDD=$P(^AUPNVHF(ZD,0),U,3) ; DATE IS PIECE 3
- . ;S OK=$$GET1^DIQ(ZHFN,ZA_",",81101,"","ZAC") ; ARRIVAL TIME
- . S ZAC=$G(^AUPNVHF(ZA,811)) ; THE TIME
- . ;S OK=$$GET1^DIQ(ZHFN,ZD_",",81101,"","ZDC") ; DEPARTURE TIME
- . S ZDC=$G(^AUPNVHF(ZD,811)) ; DEPARTURE TIME
- . N ZT ; THE TIME DIFFERENCE BETWEEN THE DATES
- . W !,!,"PATIENT: ",ZI," ",$P(^DPT(ZI,0),U,1)
- . W !,"IN: ",$$FMTE^XLFDT(ZAD_"."_ZAC)," OUT: ",$$FMTE^XLFDT(ZDD_"."_ZDC)
- . S G1=($E(ZDC,1,2)*60)+($E(ZDC,3,4))
- . S G2=($E(ZAC,1,2)*60)+($E(ZAC,3,4))
- . I (ZDD-ZAD)>0 S G1=G1+(((ZDD-ZAD)*24)*60)
- . S GTOT=G1-G2
- . W !,"TIME: ",GTOT," ESTIMATED"
- . S ZT=$$DTDIFF^C0QUTIL(ZDD,ZDC,ZAD,ZAC) ; COMPUTE THE DIFFERENCE IN MINUTES
- . W !,"COMPUTED MINUTES: ",ZT
- . ;I ZT'=GTOT B  ; LET'S FIND OUT WHAT'S WRONG
- . I ZT<0 D  Q  ; SKIP PATIENTS WITH NEGATIVE TIMES
- . . W !,"****EXCLUDED****"
- . I ZT>400000 D  Q  ; THESE ARE ERRORS
- . . W !,"****EXCLUDED****"
- . S ZARY1(ZT,ZI)="" ; ARRAY ORDERED BY MINUTES OF PATIENTS
- N ZY,ZZ S ZY="" S ZZ=""
- N ZCOUNT S ZCOUNT=0
- F  S ZY=$O(ZARY1(ZY)) Q:ZY=""  D  ; FOR EACH TIME
- . F  S ZZ=$O(ZARY1(ZY,ZZ)) Q:ZZ=""  D  ; FOR EACH PATIENT WITH THIS TIME
- . . S ZCOUNT=ZCOUNT+1
- . . S ZARY2(ZCOUNT,ZY,ZZ)=""
- . . ;W !,ZCOUNT," PATIENT: ",ZZ," MINUTES: ",ZY
- N ZMID
- S ZMID=$P(ZCOUNT/2,".")
- W !,"NUMBER OF PATIENTS IN REPORT: ",ZCOUNT
- W !,"ED ARRIVAL TIME UNTIL ",ZHF
- W !,"MEDIAN TIME: ",$O(ZARY2(ZMID,""))
- Q
- ;
-RPATLN(ZLST) ; EXTRINSIC RETURNS THE GLOBAL NAME OF THE REMINDER PATIENT LIST
- ; WHOSE NAME IS ZLST
- N ZIEN,ZN
- S ZIEN=$O(^PXRMXP(810.5,"B",ZLST,"")) ; ien of patient list
- S ZN=$NA(^PXRMXP(810.5,ZIEN,30,"B")) ; GLOBAL NAME IN REMINDER PATIENT LIST
- Q ZN
- ;
-PATLN(ZATTR) ; EXTRINSIC RETURNS THE NAME OF THE PATIENT LIST WITH
- ; THE ATTRIBUTE ZATTR
- N ZIEN,ZN
- S ZIEN=$O(^C0Q(301,"CATTR",ZATTR,"")) ; ien of patient list
- S ZN=$NA(^C0Q(301,ZIEN,1,"B")) ; NAME OF PATIENT LIST IN C0Q PATIENT LIST
- Q ZN
- ;
-INLIST(ZLIST,DFN) ; EXTRINSIC FOR IS PATIENT ALREADY IN LIST ZLIST
- N ZL,ZR
- S ZL=$O(^C0Q(301,"CATTR",ZLIST,"")) ; IEN OF LIST IN C0Q PATIENT LIST FILE
- I ZL="" Q 0 ; LIST DOES NOT EXIST
- S ZR=0 ; ASSUME NOT IN LIST
- I $D(^C0Q(301,ZL,1,"B",DFN)) S ZR=1 ; PATIENT IS IN LIST
- Q ZR
- ;
- ; LOOK AT GETTING RID OF PRINT AND SS AS THEY ARE NOT BEING USED. GPL
-PRINT ; PRINT TO SCREEN 
- I $D(WARD) W !!,WARD_"-"_WARDNAME_" "_RB_": "_PTNAME_"("_PTSEX_") "
- I $D(EXDTE) D  ;
- . W !,"Discharge Date: ",EXDTE
- . W !,DFN," ",PTNAME
- W !,"DOB: ",PTDOB," HRN: ",PTHRN
- W !,"Language Spoken: ",$G(PTLANG)
- W !,"Race: ",RACEDSC
- W !,"Ethnicity: ",$G(ETHNDSC)
- W !,"Problems: "
- W !,PBDESC
- W !,"Allergies: "
- W !,ALDESC
- W !,"Medications: "
- W !
- Q
- ;
-SS ; CREATE SPREADSHEET ARRAY
- S G1("Patient")=DFN
- I $D(WARD) D  ;
- . S G1("WardName")=WARDNAME
- . S G1("RoomAndBed")=RB
- I $D(EXDTE) D ; 
- . S G1("DischargeDate")=EXDTE
- S G1("PatientName")=PTNAME
- S G1("Gender")=PTSEX
- S G1("DateOfBirth")=PTDOB
- S G1("HealthRecordNumber")=PTHRN
- S G1("LanguageSpoken")=$G(PTLANG)
- S G1("Race")=RACEDSC
- S G1("Ehtnicity")=$G(ETHNDSC)
- S G1("Problem")=PBDESC
- I PBDESC["No problems found" S G1("HasProblem")=0
- E  S G1("HasProblem")=1
- S G1("Allergies")=ALDESC
- I ALDESC["No Allergy" S G1("HasAllergy")=0
- E  S G1("HasAllergy")=1
- I $D(MDITEM) D  ;
- . S G1("HasMed")=1
- E  S G1("HasMed")=0
- S G1("MedDescription")=$G(MDDESC)
- I $D(MDITEM) W !,"("_MDITEM_")"_MDDESC E  W !,MDDESC
- D RNF1TO2B^C0CRNF("GRSLT","G1")
- K G1
- Q  ; DON'T WANT TO DO THE NHIN STUFF NOW
- ;
-PATLIST ; CREATE PATIENT LISTS
- ; WANT TO GET RID OF PATLIST AND MOVE FUNCTION TO OTHER ROUTINES. GPL
- S C0QLIST(ZYR_"Patient",DFN)="" ; THE PATIENT LIST
- N DEMOYN S DEMOYN=1
- I $G(PTSEX)="" S DEMOYN=0
- I $G(PTDOB)="" S DEMOYN=0
- I $G(PTHRN)="" S DEMOYN=0
- I $G(PTLANG)="" S DEMOYN=0
- I $G(RACEDSC)="" S DEMOYN=0
- I $G(ETHNDSC)="" S DEMOYN=0
- ;I DEMOYN S C0QLIST("HasDemographics",DFN)=""
- ;E  S C0QLIST("FailedDemographics",DFN)=""
- ;S G1("Gender")=PTSEX
- ;S G1("DateOfBirth")=PTDOB
- ;S G1("HealthRecordNumber")=PTHRN
- ;S G1("LanguageSpoken")=$G(PTLANG)
- ;S G1("Race")=RACEDSC
- ;S G1("Ehtnicity")=$G(ETHNDSC)
- S G1("Problem")=PBDESC
- I PBDESC["No problems found" S C0QLIST(ZYR_"NoProblem",DFN)=""
- E  S C0QLIST(ZYR_"HasProblem",DFN)=""
- ;S G1("Allergies")=ALDESC
- I ALDESC["No Allergy" S C0QLIST(ZYR_"NoAllergy",DFN)=""
- E  S C0QLIST(ZYR_"HasAllergy",DFN)=""
- ;I $D(MDITEM) D  ;
-        ;. S C0QLIST("HasMed",DFN)=""
- ;E  S G1("NoMed",DFN)=""
- ;S G1("MedDescription")=$G(MDDESC)
- Q
- ;
-NHIN ; SHOW THE NHIN ARRAY FOR THIS PATIENT
- Q:DFN=137!14
- D EN^C0CNHIN(.G,DFN,"")
- ZWR G
- K G
- ;
- QUIT  ;end of WARD
- ;
-LOCPAT(PREFIX,LOC)   ;retrieve active outpatients
- ; PREFIX WILL GO IN C0XLIST(PREFIX_"-PATIENT",DFN)=""
- ; LOC IS HOSPITAL LOCATION
- S ULOC=$O(^SC("B",LOC,"")) ; IEN OF HOSPITAL LOCATION
- I ULOC="" D  Q  ; OOPS
- . W !,"HOSPITAL LOCATION NOT FOUND: ",LOC
- S IDTE=9999999-DTE ; INVERSE DATE
- N ZI
- S ZI="" ; BEGIN AT LATEST DATE FOR THIS LOC IN VISIT FILE
- F  S ZI=$O(^AUPNVSIT("AHL",ULOC,ZI)) Q:(ZI="")!(ZI>IDTE)  D  ; FOR EACH DATE
- . W !,$$FMTE^XLFDT(9999999-ZI) ;B  ;
- . I ZI="" Q  ;
- . N ZJ S ZJ=""
- . F  S ZJ=$O(^AUPNVSIT("AHL",ULOC,ZI,ZJ)) Q:ZJ=""  D  ; FOR EACH VISIT
- . . S DFN=$$GET1^DIQ(9000010,ZJ,.05,"I") ; PATIENT
- . . S C0QLIST(PREFIX_"Patient",DFN)=""
- Q
- ;
-EPPAT(ZYR) ; BUILD ALL PATIENT LISTS FOR CLINICS
- ;
- S DTE=3111000
- S MUYR=ZYR
- N ZC,ZN
- S ZN=0
- N ZI S ZI=0
- F  S ZI=$O(^SC(ZI)) Q:+ZI=0  D  ; FOR EVERY HOSPITAL LOCATION
- . I $$GET1^DIQ(44,ZI_",",2,"I")'="C" Q   ; NOT A CLINIC
- . S ZC=$$GET1^DIQ(44,ZI_",",.01) ; NAME OF CLINIC
- . S ZCIEN=ZI ; IEN OF CLINIC
- . S ZN=ZN+1 ; COUNT OF CLINICS
- . S PRE=MUYR_"-EP-"_ZC_"-"
- . D LOCPAT(PRE,ZC)
- W !,"NUMBER OF CLINICS: ",ZN
- D FILE ; CREATE ALL THE EP PATIENT LISTS
- Q
- ;
-DOEP ; DO EP COMPUTATIONS
- S ZYR="MU12-"
- N C0QPARM,C0QCLNC
- D INIT("C0QPARM","EP") ; INITIALIZE PARAMETERS
- K C0QLIST ; CLEAR THE LIST
- N ZI S ZI=""
- F  S ZI=$O(C0QPARM(ZI)) Q:ZI=""  D  ; FOR EACH EP
- . S DTE=C0QPARM(ZI,"EPBeginDate") ; beginning of measurement period
- . S EDTE=C0QPARM(ZI,"EPEndDate") ; end of measurement period -- tbd use this
- . S C0QCLNC=C0QPARM(ZI,"CLINICS",1,1) ; only one clinic for now
- . S PRE=ZYR_"EP-"_C0QCLNC_"-"
- . D LOCPAT(PRE,C0QCLNC) ; GET THE PATIENTS
- . I $D(DEBUG) ZWR C0QLIST
- . M C0QLIST(ZYR_"EP-ALL-PATIENTS")=C0QLIST(PRE_"Patient")
- S DFN=""
- S ZYR=ZYR_"EP-"
- F  S DFN=$O(C0QLIST(ZYR_"ALL-PATIENTS",DFN)) Q:DFN=""  D  ; EACH PATIENT
- . D DEMO
- . D PROBLEM
- . D ALLERGY
- . ;D MEDS
- . D ERX
- . D SMOKING
- . D VITALS
- D FILE ; FILE THE PATIENT LISTS
- N C0QCIEN
- S ZI=""
- F  S ZI=$O(C0QPARM(ZI)) Q:ZI=""  D  ;
- . S C0QCIEN=C0QPARM(ZI,"EPMeasurementSet") ; ien of measurement set
- . D UPDATE^C0QUPDT(.G,C0QCIEN) ; UPDATE THE MU MEASUREMENT SET
- Q
- ;
-DIS; 
- N DFN,DTE,EXDTE S DTE=""
- F  D  Q:DTE=""
- . S DTE=$O(^DGPM("B",DTE))
- . Q:'DTE
- . ;Q:$P(DTE,".")<3110703
- . Q:$P(DTE,".")<3111000 ; NEW BEGIN DATE FOR FISCAL YEAR 2012
- . S EXDTE=$$FMTE^XLFDT(DTE)
- . N PTFM S PTFM=""
- . D
- . . S PTFM=$O(^DGPM("B",DTE,PTFM))
- . . Q:'PTFM
- . . S DFN=$P(^DGPM(PTFM,0),U,3)
- . . S C0QLIST(ZYR_"Patient",DFN)=""
- . . D DEMO
- . . D PROBLEM
- . . D ALLERGY
- . . D MEDS4
- . . D RECON2
- . . D ADVDIR
- . . D SMOKING
- . . D VITALS
- . . ;D:$P(DTE,".")>3110912 VTE1
- . . D VTE1
- . . D COD
- . . D EDTIME
- . . I C0QPR D PRINT
- . . I C0QSS D SS
- . . I C0QPL D PATLIST
- Q
- ;
-C0QPLF() Q 1130580001.301 ; FILE NUMBER FOR C0Q PATIENT LIST FILE
-C0QALFN() Q 1130580001.311 ; FILE NUMBER FOR C0Q PATIENT LIST PATIENT SUBFILE
-FILE ; FILE THE PATIENT LISTS TO C0Q PATIENT LIST
- ;
- I '$D(C0QLIST) Q  ;
- N LFN S LFN=$$C0QALFN()
- N ZI,ZN
- S ZI=""
- F  S ZI=$O(C0QLIST(ZI)) Q:ZI=""  D  ;
- . S ZN=$O(^C0Q(301,"CATTR",ZI,""))
- . I ZN="" D  ; LIST NOT FOUND, CREATE IT
- . . K C0QFDA
- . . S FN=$$C0QPLF ; C0Q PATIENT LIST FILE
- . . S C0QFDA(FN,"+1,",.01)=ZI
- . . S C0QFDA(FN,"+1,",999)=ZI ; ATTRIBUTE
- . . W !,"CREATING ",ZI
- . . D UPDIE ; ADD THE RECORD
- . . S ZN=$O(^C0Q(301,"CATTR",ZI,"")) ; THE NEW IEN
- . ;I ZN="" D  Q  ; OOPS
- . ;. W !,"ERROR, ATTRIBUTE NOT FOUND IN PATIENT LIST FILE:"_ZI
- . ;S ZN=$$KLNCR(ZN) ; KILL AND RECREATE RECORD ZN
- . N C0QNEW,C0QOLD,C0QRSLT
- . S C0QNEW=$NA(C0QLIST(ZI)) ; THE NEW PATIENT LIST
- . S C0QOLD=$NA(^C0Q(301,ZN,1,"B")) ; THE OLD PATIENT LIST
- . D UNITY^C0QSET("C0QRSLT",C0QNEW,C0QOLD) ; FIND WHAT'S NEW
- . N ZJ,ZK
- . ; FIRST, DELETE THE OLD ONES - NO LONGER IN THE LIST
- . K C0QFDA
- . S ZJ=""
- . F  S ZJ=$O(C0QRSLT(2,ZJ)) Q:ZJ=""  D  ; MARKED WITH A 2 FROM UNITY
- . . S ZK=$O(@C0QOLD@(ZJ,"")) ; GET THE IEN OF THE RECORD TO DELETE
- . . I ZK="" D  Q  ; OOPS SHOULDN'T HAPPEN
- . . . W !,"INTERNAL ERROR FINDING A PATIENT TO DELETE"
- . . . B
- . . S C0QFDA(LFN,ZK_","_ZN_",",.01)="@"
- . I $D(C0QFDA) D UPDIE ; PROCESS THE DELETIONS
- . ; SECOND, PROCESS THE ADDITIONS
- . K C0QFDA
- . S ZJ="" S ZK=1
- . F  S ZJ=$O(C0QRSLT(0,ZJ)) Q:ZJ=""  D  ; PATIENTS TO ADD ARE MARKED WITH 0
- . . S C0QFDA(LFN,"+"_ZK_","_ZN_",",.01)=ZJ
- . . S ZK=ZK+1
- . I $D(C0QFDA) D UPDIE ; PROCESS THE ADDITIONS
- ;. Q
- ;. K C0QFDA
- ;. N ZJ,ZC
- ;. S ZJ="" S ZC=1
- ;. F  S ZJ=$O(C0QLIST(ZI,ZJ)) Q:ZJ=""  D  ; FOR EACH PAT IN LIST
- ;. . S C0QFDA(LFN,"?+"_ZC_","_ZN_",",.01)=ZJ
- ;. . S ZC=ZC+1
- ;. D UPDIE
- ;. W !,"FOUND:"_ZI
- Q
- ;
-KLNCR(ZREC) ; KILL AND RECREATE RECORD ZREC IN PATIENT LIST FILE
- ;
- N C0QFDA,ZFN,LIST,ATTR
- S ZFN=$$C0QPLF() ; FILE NUMBER FOR C0Q PATIENT LIST FILE
- D CLEAN^DILF
- S LIST=$$GET1^DIQ(ZFN,ZREC_",",.01) ;  MEASURE NAME
- S ATTR=$$GET1^DIQ(ZFN,ZREC_",",999) ; ATTRIBUTE
- D CLEAN^DILF
- K ZERR
- S C0QFDA(ZFN,ZREC_",",.01)="@" ; GET READY TO DELETE THE MEASURE
- D FILE^DIE(,"C0QFDA","ZERR") ; KILL THE SUBFILE
- I $D(ZERR) S ZZERR=ZZERR ; ZZERR DOESN'T EXIST, INVOKE THE ERROR TRAP IF TASKED
- ;. W "ERROR",!
- ;. ZWR ZERR
- ;. B
- K C0QFDA
- S C0QFDA(ZFN,"+1,",.01)=LIST ; GET READY TO RECREATE THE RECORD
- S C0QFDA(ZFN,"+1,",999)=ATTR ; ATTRIBUTE
- D UPDIE ; CREATE THE SUBFILE
- N ZR ; NEW IEN FOR THE RECORD
- S ZR=$O(^C0Q(301,"CATTR",ATTR,""))
- ;
- Q ZR
- ;
-UPDIE ; INTERNAL ROUTINE TO CALL UPDATE^DIE AND CHECK FOR ERRORS
- K ZERR
- D CLEAN^DILF
- D UPDATE^DIE("","C0QFDA","","ZERR")
- I $D(ZERR) S ZZERR=ZZERR ; ZZERR DOESN'T EXIST, INVOKE THE ERROR TRAP IF TASKED
- ;. W "ERROR",!
- ;. ZWR ZERR
- ;. B
- K C0QFDA
- Q
- ;
- ; WHAT FOLLOWS IS OLD CODE - DELETE WHEN THIS WORKS
- ;. . N PTNAME S PTNAME=$P(^DPT(DFN,0),U,1)
- ;. . S PTDOB=$$FMTE^XLFDT($P($G(^DPT(DFN,0)),U,3)) ;date of birth
- ;. . S PTSEX=$P($G(^DPT(DFN,0)),U,2) ;patient sex
- ;. . D PID^VADPT ;VADPT call to grab PISD based on PT Eligibility
- ;. . S PTHRN=$P($G(VA("PID")),U) ;health record number
- ;. . S PTRLANG=$P($G(^DPT(DFN,256000)),U) ;ptr to language file
- ;. . I $G(PTRLANG)'="" S PTLANG=$P(^DI(.85,PTRLANG,0),U) ;PLS extrnl
- ;. . S RACE=""
- ;. . F  D  Q:RACE=""
- ;. . . S RACE=$O(^DPT(DFN,.02,"B",RACE))
- ;. . . Q:'RACE
- ;. . . S RACEDSC=$P($G(^DIC(10,RACE,0)),U)
- ;. . N ETHNDSC
- ;. . N ETHNDSC S ETHNDSC=""
- ;. . S ETHN=""
- ;. . F  D  Q:ETHN=""
- ;. . . S ETHN=$O(^DPT(DFN,.06,"B",ETHN))
- ;. . . Q:'ETHN
- ;. . . S ETHNDSC=$P($G(^DIC(10.2,ETHN,0)),U)
- ;. . D LIST^ORQQPL(.PROBL,DFN,"A")
- ;. . S PBCNT=""
- ;. . F  S PBCNT=$O(PROBL(PBCNT)) Q:PBCNT=""  D
- ;. . . S PBDESC=$P(PROBL(PBCNT),U,2) ;problem description
- ;. . K PROBL
- ;. . D LIST^ORQQAL(.ALRGYL,DFN)
- ;. . S ALCNT=""
- ;. . F  S ALCNT=$O(ALRGYL(ALCNT)) Q:ALCNT=""  D
- ;. . . S ALDESC=$P(ALRGYL(ALCNT),U,2) ;allergy description
- ;. . K ALRGYL
- ;. . D COVER^ORWPS(.MEDSL,DFN)
- ;. . S MDCNT=""
- ;. . F  S MDCNT=$O(MEDSL(MDCNT)) Q:MDCNT=""  D
- ;. . . Q:$P(MEDSL(MDCNT),U,4)'="ACTIVE"  ;active medications only
- ;. . . S MDDESC=$P(MEDSL(MDCNT),U,2) ;medication description
- ;. . . S MDITEM=$P($G(MEDSL(MDCNT)),U,3)
- ;. . K MEDSL
- ;. . W !,"Discharge Date: ",EXDTE
- ;. . W !,DFN," ",PTNAME
- ;. . W !,"DOB: ",PTDOB," HRN: ",PTHRN
- ;. . W !,"Language Spoken: ",$G(PTLANG)
- ;. . W !,"Race: ",RACEDSC
- ;. . W !,"Ethnicity: ",ETHNDSC
- ;. . W !,"Problems: "
- ;. . W !,PBDESC
- ;. . W !,"Allergies: "
- ;. . W !,ALDESC
- ;. . W !,"Medications: "
- ;. . I $D(MDITEM) W !,"(",MDITEM,")",MDDESC E  W !,MDDESC
- ;. . W !
- ;Q
- ;
- ;
- ;
- ;
-END ;end of C0QPRML;
+C0QMU12	;JJOH/ZAG/GPL - Patient Reminder List ; 5/23/12 5:43pm
+	;;1.0;C0Q;;May 21, 2012;Build 43
+	;
+	;2011 Zach Gonzales<zach@linux.com> - 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.
+	;
+	; GPL - THIS ROUTINE IS A COPY OF JJOHMU11 THAT HAS BEEN MODIFIED
+	; FOR MEANINGFUL USE CALCULATION FOR FISCAL YEAR 2012 AT OROVILLE HOSPITAL
+	;
+C0QPFN()	Q 1130580001.401 ; PARAMETER FILE
+C0QPCFN()	Q 1130580001.411 ; CLINIC SUBFILE
+C0QMFN()	Q 1130580001.201 ; FILE NUMBER FOR C0Q MEASUREMENT FILE
+C0QMMFN()	Q 1130580001.2011 ; FN FOR MEASURE SUBFILE
+INIT(ZARY,ZTYP)	; INITIALIZE THE PARAMETERS FOR BUILDING PATIENT LISTS
+	; ZARY IS PASSED BY NAME
+	; ZTYP IS "INP" OR "EP"
+	N ZMU S ZMU="MU12" ; THIS IS THE ONLY HARD CODED VALUE LEFT
+	; TBD - CHANGE IT TO A READ FROM SYSTEM PARAMETERS
+	K @ZARY ; CLEAR RETURN ARRAY
+	N ZIEN,ZCNT,ZX
+	I $O(^C0Q(401,"MUTYP",ZMU,ZTYP,""))="" D  Q  ; OOPS NO RECORD THERE
+	. W !,"ERROR, NO PARAMETERS AVAILABLE"
+	S ZIEN=""
+	S ZCNT=0
+	F  S ZIEN=$O(^C0Q(401,"MUTYP",ZMU,ZTYP,ZIEN)) Q:ZIEN=""  D  ;
+	. S ZCNT=ZCNT+1
+	. S @ZARY@(ZCNT,"MU")=$$GET1^DIQ($$C0QPFN,ZIEN_",",.02)
+	. S @ZARY@(ZCNT,"TYPE")=$$GET1^DIQ($$C0QPFN,ZIEN_",",.03)
+	. S ZX=$$GET1^DIQ($$C0QPFN,ZIEN_",",1,"I")
+	. S @ZARY@(ZCNT,"InpatientMeasurementSet")=ZX
+	. S @ZARY@(ZCNT,"InpatientBeginDate")=$$GET1^DIQ($$C0QMFN,ZX_",",.02,"I")
+	. S @ZARY@(ZCNT,"InpatientEndDate")=$$GET1^DIQ($$C0QMFN,ZX_",",.03,"I")
+	. S @ZARY@(ZCNT,"InpatientQualitySet")=$$GET1^DIQ($$C0QPFN,ZIEN_",",1.1,"I")
+	. S ZX=$$GET1^DIQ($$C0QPFN,ZIEN_",",2,"I")
+	. S @ZARY@(ZCNT,"EPMeasurementSet")=ZX
+	. S @ZARY@(ZCNT,"EPBeginDate")=$$GET1^DIQ($$C0QMFN,ZX_",",.02,"I")
+	. S @ZARY@(ZCNT,"EPEndDate")=$$GET1^DIQ($$C0QMFN,ZX_",",.03,"I")
+	. S @ZARY@(ZCNT,"EPQualitySet")=$$GET1^DIQ($$C0QPFN,ZIEN_",",2.1,"I")
+	. S @ZARY@(ZCNT,"InpatientQualitySet")=$$GET1^DIQ($$C0QPFN,ZIEN_",",1.1,"I")
+	. D CLEAN^DILF
+	. D LIST^DIC($$C0QPCFN,","_ZIEN_",",".01I")
+	. I $D(^TMP("DIERR",$J)) D  Q  ; ERROR READING CLINIC LIST
+	. . W !,"ERROR READING CLINIC PARAMETER LIST"
+	. M @ZARY@(ZCNT,"CLINICS")=^TMP("DILIST",$J)
+	;
+	Q
+	;
+BUILD	; CALL ALL AND DIS AND BUILD THE GRSLT ARRAY or print or create
+	; patient lists
+	;N GRSLT ; ARRAY FOR RESULTS
+	I '$D(C0QSS) S C0QSS=0 ;default don't build spreadsheet array
+	I '$D(C0QPR) S C0QPR=0 ;default don't print out results
+	I '$D(C0QPL) S C0QPL=1 ;default do create patient lists
+	S ZYR="MU12-"
+	D INITCLST ; initialize C0QLIST
+	N G1 ; ONE SET OF VALUES - RNF1 FORMAT
+	N C0QPARM
+	D INIT("C0QPARM","INP") ; initialize inpatient parms
+	I $O(C0QPARM(""))="" D  Q  ; no parms for inpatient
+	. W !,"No inpatient parameters"
+	N ZDIV S ZDIV=""
+	F  S ZDIV=$O(C0QPARM(ZDIV)) Q:ZDIV=""  D  ; for each inpatient division
+	. D ALL ; all currently admitted patients in the hospital
+	. D DIS ; all patients discharged since the reporting period began
+	. I C0QSS ZWRITE GRSLT
+	. ;D ICUPAT ; GENERATE ICU PATIENT LIST
+	. I C0QPL D  ;
+	. . D FILE ; FILE THE PATIENT LISTS
+	. . D UPDATE^C0QUPDT(.G,C0QPARM(ZDIV,"InpatientMeasurementSet")) ; 
+	. . D UPDATE^C0QUPDT(.G,C0QPARM(ZDIV,"InpatientQualitySet")) ; 
+	. K C0QLIST
+	Q
+	;
+INITCLST	; initialize C0QLIST
+	; INITIALIZE LISTS
+	; this is done so that if there are no matching patients, the patient list
+	; will be zeroed out
+	K C0QLIST
+	S C0QLIST(ZYR_"HasDemographics")=""
+	S C0QLIST(ZYR_"Patient")=""
+	S C0QLIST(ZYR_"HasProblem")=""
+	S C0QLIST(ZYR_"HasAllergy")=""
+	S C0QLIST(ZYR_"HasMed")=""
+	S C0QLIST(ZYR_"HasVitalSigns")=""
+	S C0QLIST(ZYR_"HasMedOrders")=""
+	S C0QLIST(ZYR_"HasSmokingStatus")=""
+	Q
+	;
+ALL	;retrieve active inpatients
+	N WARD S WARD=""
+	F  D  Q:WARD=""
+	. S WARD=$O(^DIC(42,"B",WARD)) ;ward name
+	. Q:WARD=""
+	. N WIEN S WIEN=""
+	. F  S WIEN=$O(^DIC(42,"B",WARD,WIEN)) Q:'WIEN  D  ;wards IEN
+	. . S WARDNAME=$P(^DIC(42,WIEN,0),U,2) ;ward name
+	. . N DFN,RB S DFN=""
+	. . F  S DFN=$O(^DPT("CN",WARD,+DFN)) Q:'DFN  D  ;DFN of patient on ward
+	. . . D DEMO
+	. . . D PROBLEM
+	. . . D ALLERGY
+	. . . D MEDS4
+	. . . D RECON2
+	. . . D ADVDIR
+	. . . D SMOKING
+	. . . D VITALS
+	. . . D VTE1
+	. . . D COD
+	. . . D EDTIME
+	. . . I C0QPR D PRINT
+	. . . I C0QSS D SS
+	. . . I C0QPL D PATLIST
+	Q
+	;
+DEMO	; patient demographics
+	K PTDOB
+	N PTNAME,PTSEX,PTHRN,PTRLANG,PTLANG,RACE,RACEDSC,ETHN,ETHNDSC,RB
+	S PTNAME=$P(^DPT(DFN,0),U) ;patient name
+	S PTDOB=$$FMTE^XLFDT($P($G(^DPT(DFN,0)),U,3)) ;date of birth
+	S PTSEX=$P($G(^DPT(DFN,0)),U,2) ;patient sex
+	D PID^VADPT ;VADPT call to grab PISD based on PT Eligibility
+	S PTHRN=$P($G(VA("PID")),U) ;health record number
+	S PTRLANG=$P($G(^DPT(DFN,256000)),U) ;ptr to language file
+	I $G(PTRLANG)'="" S PTLANG=$P(^DI(.85,PTRLANG,0),U) ;PLS extrnl
+	S RACE=""
+	F  D  Q:RACE=""
+	. S RACE=$O(^DPT(DFN,.02,"B",RACE)) ;race code IEN
+	. Q:'RACE
+	. S RACEDSC=$P($G(^DIC(10,RACE,0)),U) ;race description
+	S ETHN=""
+	F  D  Q:ETHN=""
+	. S ETHN=$O(^DPT(DFN,.06,"B",ETHN)) ;ethnicity IEN
+	. Q:'ETHN
+	. S ETHNDSC=$P($G(^DIC(10.2,ETHN,0)),U) ;ethnincity description
+	S RB=$P($G(^DPT(DFN,.101)),U) ;room and bed
+	N DEMOYN S DEMOYN=1
+	I $G(PTSEX)="" S DEMOYN=0
+	I $G(PTDOB)="" S DEMOYN=0
+	I $G(PTHRN)="" S DEMOYN=0
+	I $G(PTLANG)="" S DEMOYN=0
+	I $G(RACEDSC)="" S DEMOYN=0
+	I $G(ETHNDSC)="" S DEMOYN=0
+	I DEMOYN S C0QLIST(ZYR_"HasDemographics",DFN)=""
+	E  S C0QLIST(ZYR_"FailedDemographics",DFN)=""
+	Q
+	;
+PROBLEM	; PATIENT PROBLEMS
+	D LIST^ORQQPL(.PROBL,DFN,"A")
+	S PBCNT=""
+	F  S PBCNT=$O(PROBL(PBCNT)) Q:PBCNT=""  D
+	. S PBDESC=$P(PROBL(PBCNT),U,2) ;problem description
+	I PBDESC["No problems found" S C0QLIST(ZYR_"NoProblem",DFN)=""
+	E  S C0QLIST(ZYR_"HasProblem",DFN)=""
+	K PROBL
+	Q
+	; 
+ALLERGY	; ALLERGY LIST
+	; WANT TO CHANGE ALLERGIES FOR 2012 TO POPULATE THE C0QLIST DIRECTLY. GPL
+	D LIST^ORQQAL(.ALRGYL,DFN)
+	S ALCNT=""
+	F  S ALCNT=$O(ALRGYL(ALCNT)) Q:ALCNT=""  D
+	. S ALDESC=$P(ALRGYL(ALCNT),U,2) ;allergy description
+	I ALDESC["No Allergy" S C0QLIST(ZYR_"NoAllergy",DFN)=""
+	E  S C0QLIST(ZYR_"HasAllergy",DFN)=""
+	K ALRGYL
+	Q
+	;
+MEDS4	; USE OCL^PSOORRL TO GET ALL MEDS
+	; DELETED MEDS, MEDS2, AND MEDS3 FOR 2012 TO USE ONLY MEDS4
+	N BEG,END
+	S BEG=$$DT^C0QUTIL("JULY 3,2011")
+	S END=$$DT^C0QUTIL("NOW")
+	D OCL^PSOORRL(DFN,BEG,END)  ;DBIA #2400
+	N C0QMEDS
+	M C0QMEDS=^TMP("PS",$J) ; MEDS RETURNED FROM CALL
+	N FOUND
+	N ZI
+	I '$D(C0QMEDS(1)) D  Q  ; QUIT IF NO MEDS
+	. S C0QLIST(ZYR_"NoMed",DFN)=""
+	E  D  ; HAS MEDS
+	. S C0QLIST(ZYR_"HasMed",DFN)=""
+	S ZI="" S FOUND=0
+	F  S ZI=$O(C0QMEDS(ZI)) Q:ZI=""  D  ; FOR EACH MED
+	. N ZM
+	. S ZM=$G(C0QMEDS(ZI,0)) ;THE MEDICATION
+	. I $P($P(ZM,"^",1),";",2)="I" D  ; IE 1U;I FOR AN INPATIENT UNIT DOSE
+	. . S FOUND=1
+	I FOUND S C0QLIST(ZYR_"HasMedOrders",DFN)="" ; MET CPOE MEASURE
+	E  S C0QLIST(ZYR_"NoMedOrders",DFN)=""
+	Q
+	;
+RECON	; MEDICATIONS RECONCILIATION
+	; WANT TO SIMPLIFY MEDS RECON FOR 2012. GPL
+	; 
+	I $$HASNTYN^C0QNOTES("MED/SURG NURSING ADMISSION ASSESSMENT",DFN) D  ;
+	. S C0QLIST(ZYR_"XferOfCare",DFN)="" ; transfer of care patient
+	N HASRECON S HASRECON=0
+	N GT,G
+	S GT(4,"HasMedRecon","MEDICATION RECONCILIATION COMPLET")=""
+	S GT(5,"HasMedRecon","Medication Reconcilation Complete")=""
+	I $$TXTALL^C0QNOTES(.G,.GT,DFN) D  ; SEARCH ALL NOTES FOR MED RECON
+	. S HASRECON=1
+	;N ZT
+	;S ZT="MEDICATION RECONCILIATION COMPLET"
+	;I $$NTTXT^C0QNOTES("ER NURSE NOTE",ZT,DFN) D  ;
+	;. S HASRECON=1
+	;E  D  ;
+	;. S ZT="Medication Reconcilation Complete"
+	;. I $$NTTXT^C0QNOTES("MED/SURG NURSING ADMISSION ASSESSMENT",ZT,DFN) D  ;
+	;. . S HASRECON=1
+	;I $$HFYN^C0QHF("MEDS HAVE BEEN REVIEWED",DFN) S HASRECON=1
+	I HASRECON D  ;
+	. S C0QLIST(ZYR_"HasMedRecon",DFN)=""
+	E  S C0QLIST(ZYR_"NoMedRecon",DFN)=""
+	Q
+	;
+RECON2	; USE HEALTH FACTORS FOR MEDICATION RECONCILIATION
+	I $$HASNTYN^C0QNOTES("MED/SURG NURSING ADMISSION ASSESSMENT",DFN) D  ;
+	. S C0QLIST(ZYR_"XferOfCare",DFN)="" ; transfer of care patient
+	I $$HFYN^C0QHF(DFN,"Medication Reconciliation Completed: Yes") D  ;
+	. S C0QLIST(ZYR_"HasMedRecon",DFN)=""
+	E  S C0QLIST(ZYR_"NoMedRecon",DFN)=""
+	Q
+	;
+ERX	; FOR EP, WE LOOK AT ERX MEDS
+	N ZI S ZI=""
+	N ZERX S ZERX=$NA(^PS(55,DFN,"NVA"))
+	F  S ZI=$O(@ZERX@(ZI)) Q:ZI=""  D  ;
+	. ;B
+	. I $G(@ZERX@(ZI,1,1,0))["E-Rx Web" D  ;
+	. . S C0QLIST(ZYR_"HasMed",DFN)=""
+	. . S C0QLIST(ZYR_"HasMedOrders",DFN)=""
+	. . S C0QLIST(ZYR_"HasERX",DFN)=""
+	. . S C0QLIST(ZYR_"HasMedRecon",DFN)=""
+	. E  D  ;
+	. . S C0QLIST(ZYR_"NoMed",DFN)=""
+	. . S C0QLIST(ZYR_"NoMedOrders",DFN)=""
+	. . S C0QLIST(ZYR_"NoERX",DFN)=""
+	. . S C0QLIST(ZYR_"NoMedRecon",DFN)=""
+	Q
+	;
+ADVDIR	; ADVANCE DIRECTIVE
+	;
+	I $$AGE^C0QUTIL(DFN)>64 D  ; ONLY FOR PATIENTS 65 AND OLDER
+	. S C0QLIST(ZYR_"Over65",DFN)=""
+	. I $$HASNTYN^C0QNOTES("ADVANCE DIRECTIVE",DFN) D  ;
+	. . S C0QLIST(ZYR_"HasAdvanceDirective",DFN)=""
+	. E  D  ;
+	. . S C0QLIST(ZYR_"NoAdvanceDirective",DFN)=""
+	Q
+	;
+SMOKING	;
+	; WANT TO CHANGE SMOKING STATUS CHECKING FOR 2012 TO A SIMPLE SET OF
+	; HEALTH FACTORS. GPL
+	I $$INLIST(ZYR_"HasSmokingStatus",DFN) D  Q  ; ALREADY HAS SMOKING STAT CHECK
+	. S C0QLIST(ZYR_"HasSmokingStatus",DFN)=""
+	. S C0QLIST(ZYR_"Over12",DFN)=""
+	I $$INLIST(ZYR_"NoSmokingStatus",DFN) D  Q  ; ALREADY HAS SMOKING STATUS CHECK
+	. S C0QLIST(ZYR_"NoSmokingStatus",DFN)=""
+	. S C0QLIST(ZYR_"Over12",DFN)=""
+	N C0QSMOKE,C0QSYN
+	S C0QSYN=0
+	I $$AGE^C0QUTIL(DFN)<13 Q  ; DON'T CHECK UNDER AGE 13
+	D HFCAT^C0QHF(.C0QSMOKE,DFN,"TOBACCO") ; GET ALL HEALTH FACTORS FOR THE
+	; PATIENT IN THE CATEGORY OF TOBACCO
+	I $D(C0QSMOKE) S C0QSYN=1
+	S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Quit Smokeless Tobacco <1 Yr Ago")
+	S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Quit Smokeless Tobacco > 20 Yrs Ago")
+	S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Quit Smokeless Tobacco: 1-5 Yrs Ago")
+	S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Quit Smokeless Tobacco: 10-20 Yrs Ago")
+	S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Quit Smokeless Tobacco: 5-10 Yrs Ago")
+	S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Quit Smoking")
+	S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Quit Smoking < 1 Yr Ago")
+	S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Quit Smoking > 20 Yrs Ago")
+	S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Quit Smoking: 1-5 Yrs Ago")
+	S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Quit Smoking: 10-20 Yrs Ago")
+	S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Quit Smoking: 5-10 Yrs Ago")
+	S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"PREVIOUS SMOKELESS TOBACCO USER")
+	S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"PREVIOUS SMOKELESS: 1-5 YRS AGO")
+	S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"PREVIOUS SMOKELESS: 10-20 YRS AGO")
+	S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"PREVIOUS SMOKELESS: 5-10 YRS AGO")
+	S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"PREVIOUS SMOKELESS: < 1 YR AGO")
+	S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"PREVIOUS SMOKELESS: > 20 YRS AGO")
+	S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"PREVIOUS SMOKER")
+	S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"PREVIOUS SMOKER 10-20 YRS")
+	S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"PREVIOUS SMOKER 20+ YRS")
+	S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"PREVIOUS SMOKER < 1 YR")
+	S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"PREVIOUS SMOKER < 1 YR AGO")
+	S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"PREVIOUS SMOKER > 20 YRS AGO")
+	S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"PREVIOUS SMOKER: 1-5 YRS")
+	S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"PREVIOUS SMOKER: 1-5 YRS AGO")
+	S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"PREVIOUS SMOKER: 10-20 YRS AGO")
+	S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"PREVIOUS SMOKER: 5-10 YRS")
+	S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"PREVIOUS SMOKER: 5-10 YRS AGO")
+	S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"PREVIOUS SMOKELESS TOBACCO USER")
+	S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"LIFETIME NON-SMOKER")
+	S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Former Smokeless Tobacco User")
+	S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Former Smoker")
+	S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Former Smoker (PMH)")
+	S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoke Exposure/2nd Hand Exposure")
+	S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For 1-5 Yrs")
+	S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For 10-20 Yrs")
+	S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For 5-10 Yrs")
+	S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For < 1 Yr")
+	S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For > 20 Yrs")
+	S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Tobacco User")
+	S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for 1-5 Yrs")
+	S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for 10-20 Yrs")
+	S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for 5-10 Yrs")
+	S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for < 1 Yr")
+	S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for > 20 Yrs")
+	S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoker (HPI)")
+	S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoking (FMH)")
+	S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoking (PMH)")
+	S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoking Cessation (OPH)")
+	S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"LIFETIME NON-SMOKER")
+	S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Former Smokeless Tobacco User")
+	S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Former Smoker")
+	S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Former Smoker (PMH)")
+	S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoke Exposure/2nd Hand Exposure")
+	S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For 1-5 Yrs")
+	S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For 10-20 Yrs")
+	S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For 5-10 Yrs")
+	S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For < 1 Yr")
+	S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For > 20 Yrs")
+	S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Tobacco User")
+	S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for 1-5 Yrs")
+	S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for 10-20 Yrs")
+	S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for 5-10 Yrs")
+	S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for < 1 Yr")
+	S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for > 20 Yrs")
+	S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoker (HPI)")
+	S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoking (FMH)")
+	S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoking (PMH)")
+	S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Non-Smoker")
+	S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"LIFETIME NON-SMOKER")
+	S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Former Smokeless Tobacco User")
+	S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Former Smoker")
+	S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Former Smoker (PMH)")
+	S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoke Exposure/2nd Hand Exposure")
+	S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For 1-5 Yrs")
+	S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For 10-20 Yrs")
+	S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For 5-10 Yrs")
+	S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For < 1 Yr")
+	S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For > 20 Yrs")
+	S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Tobacco User")
+	S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for 1-5 Yrs")
+	S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for 10-20 Yrs")
+	S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for 5-10 Yrs")
+	S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for < 1 Yr")
+	S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for > 20 Yrs")
+	S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoker (HPI)")
+	S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoking (FMH)")
+	S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoking (PMH)")
+	S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"LIFETIME NON-SMOKER")
+	S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Former Smokeless Tobacco User")
+	S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Former Smoker")
+	S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Former Smoker (PMH)")
+	S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoke Exposure/2nd Hand Exposure")
+	S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For 1-5 Yrs")
+	S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For 10-20 Yrs")
+	S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For 5-10 Yrs")
+	S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For < 1 Yr")
+	S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For > 20 Yrs")
+	S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Tobacco User")
+	S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for 1-5 Yrs")
+	S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for 10-20 Yrs")
+	S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for 5-10 Yrs")
+	S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for < 1 Yr")
+	S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for > 20 Yrs")
+	S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoker (HPI)")
+	S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoking (FMH)")
+	S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoking (PMH)")
+	S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Non-Smoker")
+	S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"LIFETIME NON-SMOKER")
+	S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Former Smokeless Tobacco User")
+	S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Former Smoker")
+	S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Former Smoker (PMH)")
+	S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoke Exposure/2nd Hand Exposure")
+	S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For 1-5 Yrs")
+	S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For 10-20 Yrs")
+	S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For 5-10 Yrs")
+	S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For < 1 Yr")
+	S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For > 20 Yrs")
+	S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Tobacco User")
+	S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for 1-5 Yrs")
+	S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for 10-20 Yrs")
+	S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for 5-10 Yrs")
+	S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for < 1 Yr")
+	S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for > 20 Yrs")
+	S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoker (HPI)")
+	S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoking (FMH)")
+	S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoking (PMH)")
+	S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Non-Smoker")
+	S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Non-Smoker (PMH)")
+	S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Non-Tobacco User")
+	S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Current Smoker - No")
+	S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Current Smoker - Yes")
+	S C0QLIST(ZYR_"Over12",DFN)=""
+	;N GT
+	;S GT(1,"HasSmokingStatus","SMOK")=""
+	;S GT(2,"HasSmokingStatus","Smok")=""
+	;S GT(3,"HasSmokingStatus","smok")=""
+	;I 'C0QSYN D  ;
+	;. N G
+	;. S OK=$$TXTALL^C0QNOTES(.G,.GT,DFN)
+	;. I $D(G) S C0QSYN=1
+	I C0QSYN S C0QLIST(ZYR_"HasSmokingStatus",DFN)=""
+	E  S C0QLIST(ZYR_"NoSmokingStatus",DFN)=""
+	Q
+	;
+VITALS	;
+	;
+	N C0QSDT,C0QEDT
+	D DT^DILF(,"JULY 3,2011",.C0QSDT) ; START DATE
+	D DT^DILF(,"T",.C0QEDT) ; END DATE TODAY
+	D VITALS^ORQQVI(.VITRSLT,DFN,C0QSDT,C0QEDT) ; CALL FAST VITALS
+	I $D(VITRSLT) D  ;ZWR VITRSLT B  ;
+	. I VITRSLT(1)["No vitals found." S C0QLIST(ZYR_"NoVitalSigns",DFN)=""
+	. E  S C0QLIST(ZYR_"HasVitalSigns",DFN)=""
+	Q
+	;
+VTE1	; VTE PROPHYLAXIS WITHIN 24HRS OF ARRIVAL
+	;
+	I $$HFYN^C0QHF(DFN,"VTE PROPHYLAXIS WITHIN 24HRS OF ARRIVAL") D  ;
+	. S C0QLIST(ZYR_"HasVTE24",DFN)=""
+	E  S C0QLIST(ZYR_"NoVTE24",DFN)=""
+	Q
+	;
+COD	; TEST FOR PRELIMINARY CAUSE OF DEATH NOTE
+	I $$HASNTYN^C0QNOTES("PRELIMINARY CAUSE OF DEATH",DFN) D  ;
+	. S C0QLIST(ZYR_"CauseOfDeath",DFN)=""
+	Q
+	;
+EDTIME	; CHECK FOR EMERGENCY DEPT TIME FACTORS
+	N FOUND
+	S FOUND=0
+	I $$HFYN^C0QHF(DFN,"ED ARRIVAL TIME") S FOUND=1
+	I '$$HFYN^C0QHF(DFN,"ED DEPARTURE TIME") S FOUND=0
+	I '$$HFYN^C0QHF(DFN,"TIME DECISION TO ADMIT MADE") S FOUND=0
+	I FOUND D  ; 
+	. S C0QLIST(ZYR_"HasEDtime",DFN)=""
+	E  S C0QLIST(ZYR_"NoEDtime",DFN)=""
+	Q
+	;
+ICUPAT	; CREATE LIST OF ICU PATIENTS
+	N ZICU
+	S ZICU=$O(^SC("B","IC","")) ; IEN OF ICU HOSPITAL LOCATION
+	N ZI,ZJ,ZP
+	S ZI=""
+	F  S ZI=$O(^AUPNVSIT("AHL",ZICU,ZI)) Q:ZI=""  D  ; EACH DATE
+	. S ZJ=""
+	. F  S ZJ=$O(^AUPNVSIT("AHL",ZICU,ZI,ZJ)) Q:ZJ=""  D  ; EACH VISIT
+	. . S ZP=$P(^AUPNVSIT(ZJ,0),"^",5) ; DFN
+	. . S C0QLIST(ZYR_"ICUPatient",ZP)=""
+	Q
+	;
+FILTER	; CALLED AFTER ALL THE PATIENT LISTS HAVE BEEN FILED
+	; WILL KILL C0QLIST AND CREATE DERIVATIVE PATIENT LISTS BY FILTERING
+	K C0QLIST
+	N ZPAT
+	S ZPAT=$$PATLN(ZYR_"Patient") ; name of patient list of all patients admitted
+	; during the reporting period. used to filter other lists
+	;
+	; filter ICU patients against ZPAT
+	N GN,GO,GF
+	S GN=ZPAT
+	S GO=$$PATLN(ZYR_"ICUPatient") ; all ICU patient
+	S GF=$NA(C0QLIST(ZYR_"ICUReporting")) ; the filtered list destination
+	D AND^C0QSET(GF,GN,GO) ; filter the list with the AND set operation
+	; 
+	; FILTER VTE-2 DENOMINATOR FOR QUALITY MEASURE
+	;
+	S GN=$NA(C0QLIST(ZYR_"ICUReporting")) ; ICU patients admitted inside rpt period
+	S GO=$$RPATLN("MU VTE-2 DENOM PL") ; TAXONOMY BASED DENOMENATOR
+	S GF=$NA(C0QLIST(ZYR_"VTE2DEN")) ; NEW DENOMINATOR PL
+	D AND^C0QSET(GF,GN,GO) ; filter the list with the AND set operation
+	;
+	S GN=ZPAT
+	S GO=$$RPATLN("MU VTE-3 DENOM PL") ; TAXONOMY BASED DENOMENATOR
+	S GF=$NA(C0QLIST(ZYR_"VTE3DEN")) ; NEW DENOMINATOR PL
+	D AND^C0QSET(GF,GN,GO) ; filter the list with the AND set operation
+	;
+	S GN=ZPAT
+	S GO=$$RPATLN("MU VTE-4 DENOM PL") ; TAXONOMY BASED DENOMENATOR
+	S GF=$NA(C0QLIST(ZYR_"VTE4DEN")) ; NEW DENOMINATOR PL
+	D AND^C0QSET(GF,GN,GO) ; filter the list with the AND set operation
+	;
+	S GN=ZPAT
+	S GO=$$RPATLN("MU VTE-5 DENOM PL") ; TAXONOMY BASED DENOMENATOR
+	S GF=$NA(C0QLIST(ZYR_"VTE5DEN")) ; NEW DENOMINATOR PL
+	D AND^C0QSET(GF,GN,GO) ; filter the list with the AND set operation
+	;
+	D FILE ; FILE ALL THE PATIENT LISTS
+	D UPDATE^C0QUPDT(.G,5) ; UPDATE THE HOS 2011 MEANINGFUL USE measure set
+	Q
+	;
+ED1	;
+	S ZYR="MU12-"
+	D DOTIME("ED DEPARTURE TIME")
+	Q
+	;
+ED2	;
+	S ZYR="MU12-"
+	D DOTIME2("TIME DECISION TO ADMIT MADE")
+	Q
+	;
+DOTIME(ZHF)	; COMPUTE THE MEAN TIME IN THE ED FROM ARRIVAL TO DEPARTURE
+	; THIS IS A QUALITY MEASURE ED-1 FOR MEANINGFUL USE
+	; IT PRINTS A REPORT OF EACH PATIENT WITH THE ED TIMES RECORDED
+	; AND THEIR TIME. AT THE END IT PRINTS THE MEAN TIME
+	N ZP
+	S ZP=$$PATLN(ZYR_"HasEDtime") ; patient list name for patients to process
+	S ZHFN=9000010.23 ; FILE NUMBER FOR V HEALTH FACTORS
+	S ZVFN=9000010 ; VISIT FILE NUMBER
+	K ZARY1,ZARY2
+	N ZI S ZI=""
+	S COUNT=0
+	F  S ZI=$O(@ZP@(ZI)) Q:ZI=""  D  ; FOR EACH PATIENT
+	. S COUNT=COUNT+1
+	. N ZA,ZD
+	. S ZA=$$VHFIEN^C0QHF(ZI,"ED ARRIVAL TIME") ; IEN OF ARRIVAL HEALTH FACTOR
+	. S ZD=$$VHFIEN^C0QHF(ZI,ZHF) ; IEN OF DEPART HEALTH FACTOR
+	. N ZAD,ZDD ; ARRIVAL DATE, DEPARTURE DATE
+	. N ZAC,ZDC ; ARRIVAL COMMENT, DEPARTURE COMMENT 
+	. ; THE COMMENT IS THE TIME XXYY
+	. N OK,TMP
+	. S TMP=$$GET1^DIQ(ZHFN,ZA_",",.03,"I") ; VISIT POINTER
+	. S ZAD=$$GET1^DIQ(ZVFN,TMP_",",.01,"I") ; VISIT DATE
+	. ;S ZAD=$P(^AUPNVHF(ZA,0),U,3) ; DATE IS PIECE 3
+	. S TMP=$$GET1^DIQ(ZHFN,ZD_",",.03,"I") ; VISIT POINTER
+	. S ZDD=$$GET1^DIQ(ZVFN,TMP_",",.01,"I") ; VISIT DATE
+	. ;S ZDD=$$GET1^DIQ(ZHFN,ZD_",",1201,"I") ; EVENT DATE FIELD
+	. ;S ZDD=$P(^AUPNVHF(ZD,0),U,3) ; DATE IS PIECE 3
+	. ;S OK=$$GET1^DIQ(ZHFN,ZA_",",81101,"","ZAC") ; ARRIVAL TIME
+	. S ZAC=$G(^AUPNVHF(ZA,811)) ; THE TIME
+	. ;S OK=$$GET1^DIQ(ZHFN,ZD_",",81101,"","ZDC") ; DEPARTURE TIME
+	. S ZDC=$G(^AUPNVHF(ZD,811)) ; DEPARTURE TIME
+	. N ZT ; THE TIME DIFFERENCE BETWEEN THE DATES
+	. W !,!,"PATIENT: ",ZI," ",$P(^DPT(ZI,0),U,1)
+	. W !,"IN: ",$$FMTE^XLFDT(ZAD_"."_ZAC)," OUT: ",$$FMTE^XLFDT(ZDD_"."_ZDC)
+	. S G1=($E(ZDC,1,2)*60)+($E(ZDC,3,4))
+	. S G2=($E(ZAC,1,2)*60)+($E(ZAC,3,4))
+	. I (ZDD-ZAD)>0 S G1=G1+(((ZDD-ZAD)*24)*60)
+	. S GTOT=G1-G2
+	. W !,"TIME: ",GTOT," ESTIMATED"
+	. S ZT=$$DTDIFF^C0QUTIL(ZDD,ZDC,ZAD,ZAC) ; COMPUTE THE DIFFERENCE IN MINUTES
+	. W !,"COMPUTED MINUTES: ",ZT
+	. ;I ZT'=GTOT B  ; LET'S FIND OUT WHAT'S WRONG
+	. I ZT<0 D  Q  ; SKIP PATIENTS WITH NEGATIVE TIMES
+	. . W !,"****EXCLUDED****"
+	. I ZT>400000 D  Q  ; THESE ARE ERRORS
+	. . W !,"****EXCLUDED****"
+	. S ZARY1(ZT,ZI)="" ; ARRAY ORDERED BY MINUTES OF PATIENTS
+	N ZY,ZZ S ZY="" S ZZ=""
+	N ZCOUNT S ZCOUNT=0
+	F  S ZY=$O(ZARY1(ZY)) Q:ZY=""  D  ; FOR EACH TIME
+	. F  S ZZ=$O(ZARY1(ZY,ZZ)) Q:ZZ=""  D  ; FOR EACH PATIENT WITH THIS TIME
+	. . S ZCOUNT=ZCOUNT+1
+	. . S ZARY2(ZCOUNT,ZY,ZZ)=""
+	. . ;W !,ZCOUNT," PATIENT: ",ZZ," MINUTES: ",ZY
+	N ZMID
+	S ZMID=$P(ZCOUNT/2,".")
+	W !,"NUMBER OF PATIENTS IN REPORT: ",ZCOUNT
+	W !,"ED ARRIVAL TIME UNTIL ",ZHF
+	W !,"MEDIAN TIME: ",$O(ZARY2(ZMID,""))
+	Q
+	;
+DOTIME2(ZHF)	; COMPUTE THE MEAN TIME IN THE ED FROM ARRIVAL TO DEPARTURE
+	; THIS IS A QUALITY MEASURE ED-1 FOR MEANINGFUL USE
+	; IT PRINTS A REPORT OF EACH PATIENT WITH THE ED TIMES RECORDED
+	; AND THEIR TIME. AT THE END IT PRINTS THE MEAN TIME
+	N ZP
+	S ZP=$$PATLN(ZYR_"HasEDtime") ; patient list name for patients to process
+	S ZHFN=9000010.23 ; FILE NUMBER FOR V HEALTH FACTORS
+	S ZVFN=9000010 ; VISIT FILE NUMBER
+	K ZARY1,ZARY2
+	N ZI S ZI=""
+	S COUNT=0
+	F  S ZI=$O(@ZP@(ZI)) Q:ZI=""  D  ; FOR EACH PATIENT
+	. S COUNT=COUNT+1
+	. N ZA,ZD
+	. ;S ZA=$$VHFIEN^C0QHF(ZI,"ED ARRIVAL TIME") ; IEN OF ARRIVAL HEALTH FACTOR
+	. ;S ZD=$$VHFIEN^C0QHF(ZI,ZHF) ; IEN OF DEPART HEALTH FACTOR
+	. S ZA=$$VHFIEN^C0QHF(ZI,ZHF) ; IEN OF DEPART HEALTH FACTOR
+	. S ZD=$$VHFIEN^C0QHF(ZI,"ED DEPARTURE TIME") ; IEN OF ARRIVAL HEALTH FACTOR
+	. N ZAD,ZDD ; ARRIVAL DATE, DEPARTURE DATE
+	. N ZAC,ZDC ; ARRIVAL COMMENT, DEPARTURE COMMENT 
+	. ; THE COMMENT IS THE TIME XXYY
+	. N OK,TMP
+	. S TMP=$$GET1^DIQ(ZHFN,ZA_",",.03,"I") ; VISIT POINTER
+	. S ZAD=$$GET1^DIQ(ZVFN,TMP_",",.01,"I") ; VISIT DATE
+	. ;S ZAD=$P(^AUPNVHF(ZA,0),U,3) ; DATE IS PIECE 3
+	. S TMP=$$GET1^DIQ(ZHFN,ZD_",",.03,"I") ; VISIT POINTER
+	. S ZDD=$$GET1^DIQ(ZVFN,TMP_",",.01,"I") ; VISIT DATE
+	. ;S ZDD=$$GET1^DIQ(ZHFN,ZD_",",1201,"I") ; EVENT DATE FIELD
+	. ;S ZDD=$P(^AUPNVHF(ZD,0),U,3) ; DATE IS PIECE 3
+	. ;S OK=$$GET1^DIQ(ZHFN,ZA_",",81101,"","ZAC") ; ARRIVAL TIME
+	. S ZAC=$G(^AUPNVHF(ZA,811)) ; THE TIME
+	. ;S OK=$$GET1^DIQ(ZHFN,ZD_",",81101,"","ZDC") ; DEPARTURE TIME
+	. S ZDC=$G(^AUPNVHF(ZD,811)) ; DEPARTURE TIME
+	. N ZT ; THE TIME DIFFERENCE BETWEEN THE DATES
+	. W !,!,"PATIENT: ",ZI," ",$P(^DPT(ZI,0),U,1)
+	. W !,"IN: ",$$FMTE^XLFDT(ZAD_"."_ZAC)," OUT: ",$$FMTE^XLFDT(ZDD_"."_ZDC)
+	. S G1=($E(ZDC,1,2)*60)+($E(ZDC,3,4))
+	. S G2=($E(ZAC,1,2)*60)+($E(ZAC,3,4))
+	. I (ZDD-ZAD)>0 S G1=G1+(((ZDD-ZAD)*24)*60)
+	. S GTOT=G1-G2
+	. W !,"TIME: ",GTOT," ESTIMATED"
+	. S ZT=$$DTDIFF^C0QUTIL(ZDD,ZDC,ZAD,ZAC) ; COMPUTE THE DIFFERENCE IN MINUTES
+	. W !,"COMPUTED MINUTES: ",ZT
+	. ;I ZT'=GTOT B  ; LET'S FIND OUT WHAT'S WRONG
+	. I ZT<0 D  Q  ; SKIP PATIENTS WITH NEGATIVE TIMES
+	. . W !,"****EXCLUDED****"
+	. I ZT>400000 D  Q  ; THESE ARE ERRORS
+	. . W !,"****EXCLUDED****"
+	. S ZARY1(ZT,ZI)="" ; ARRAY ORDERED BY MINUTES OF PATIENTS
+	N ZY,ZZ S ZY="" S ZZ=""
+	N ZCOUNT S ZCOUNT=0
+	F  S ZY=$O(ZARY1(ZY)) Q:ZY=""  D  ; FOR EACH TIME
+	. F  S ZZ=$O(ZARY1(ZY,ZZ)) Q:ZZ=""  D  ; FOR EACH PATIENT WITH THIS TIME
+	. . S ZCOUNT=ZCOUNT+1
+	. . S ZARY2(ZCOUNT,ZY,ZZ)=""
+	. . ;W !,ZCOUNT," PATIENT: ",ZZ," MINUTES: ",ZY
+	N ZMID
+	S ZMID=$P(ZCOUNT/2,".")
+	W !,"NUMBER OF PATIENTS IN REPORT: ",ZCOUNT
+	W !,"ED ARRIVAL TIME UNTIL ",ZHF
+	W !,"MEDIAN TIME: ",$O(ZARY2(ZMID,""))
+	Q
+	;
+RPATLN(ZLST)	; EXTRINSIC RETURNS THE GLOBAL NAME OF THE REMINDER PATIENT LIST
+	; WHOSE NAME IS ZLST
+	N ZIEN,ZN
+	S ZIEN=$O(^PXRMXP(810.5,"B",ZLST,"")) ; ien of patient list
+	S ZN=$NA(^PXRMXP(810.5,ZIEN,30,"B")) ; GLOBAL NAME IN REMINDER PATIENT LIST
+	Q ZN
+	;
+PATLN(ZATTR)	; EXTRINSIC RETURNS THE NAME OF THE PATIENT LIST WITH
+	; THE ATTRIBUTE ZATTR
+	N ZIEN,ZN
+	S ZIEN=$O(^C0Q(301,"CATTR",ZATTR,"")) ; ien of patient list
+	S ZN=$NA(^C0Q(301,ZIEN,1,"B")) ; NAME OF PATIENT LIST IN C0Q PATIENT LIST
+	Q ZN
+	;
+INLIST(ZLIST,DFN)	; EXTRINSIC FOR IS PATIENT ALREADY IN LIST ZLIST
+	N ZL,ZR
+	S ZL=$O(^C0Q(301,"CATTR",ZLIST,"")) ; IEN OF LIST IN C0Q PATIENT LIST FILE
+	I ZL="" Q 0 ; LIST DOES NOT EXIST
+	S ZR=0 ; ASSUME NOT IN LIST
+	I $D(^C0Q(301,ZL,1,"B",DFN)) S ZR=1 ; PATIENT IS IN LIST
+	Q ZR
+	;
+	; LOOK AT GETTING RID OF PRINT AND SS AS THEY ARE NOT BEING USED. GPL
+PRINT	; PRINT TO SCREEN 
+	I $D(WARD) W !!,WARD_"-"_WARDNAME_" "_RB_": "_PTNAME_"("_PTSEX_") "
+	I $D(EXDTE) D  ;
+	. W !,"Discharge Date: ",EXDTE
+	. W !,DFN," ",PTNAME
+	W !,"DOB: ",PTDOB," HRN: ",PTHRN
+	W !,"Language Spoken: ",$G(PTLANG)
+	W !,"Race: ",RACEDSC
+	W !,"Ethnicity: ",$G(ETHNDSC)
+	W !,"Problems: "
+	W !,PBDESC
+	W !,"Allergies: "
+	W !,ALDESC
+	W !,"Medications: "
+	W !
+	Q
+	;
+SS	; CREATE SPREADSHEET ARRAY
+	S G1("Patient")=DFN
+	I $D(WARD) D  ;
+	. S G1("WardName")=WARDNAME
+	. S G1("RoomAndBed")=RB
+	I $D(EXDTE) D  ; 
+	. S G1("DischargeDate")=EXDTE
+	S G1("PatientName")=PTNAME
+	S G1("Gender")=PTSEX
+	S G1("DateOfBirth")=PTDOB
+	S G1("HealthRecordNumber")=PTHRN
+	S G1("LanguageSpoken")=$G(PTLANG)
+	S G1("Race")=RACEDSC
+	S G1("Ehtnicity")=$G(ETHNDSC)
+	S G1("Problem")=PBDESC
+	I PBDESC["No problems found" S G1("HasProblem")=0
+	E  S G1("HasProblem")=1
+	S G1("Allergies")=ALDESC
+	I ALDESC["No Allergy" S G1("HasAllergy")=0
+	E  S G1("HasAllergy")=1
+	I $D(MDITEM) D  ;
+	. S G1("HasMed")=1
+	E  S G1("HasMed")=0
+	S G1("MedDescription")=$G(MDDESC)
+	I $D(MDITEM) W !,"("_MDITEM_")"_MDDESC E  W !,MDDESC
+	D RNF1TO2B^C0CRNF("GRSLT","G1")
+	K G1
+	Q  ; DON'T WANT TO DO THE NHIN STUFF NOW
+	;
+PATLIST	; CREATE PATIENT LISTS
+	; WANT TO GET RID OF PATLIST AND MOVE FUNCTION TO OTHER ROUTINES. GPL
+	S C0QLIST(ZYR_"Patient",DFN)="" ; THE PATIENT LIST
+	N DEMOYN S DEMOYN=1
+	I $G(PTSEX)="" S DEMOYN=0
+	I $G(PTDOB)="" S DEMOYN=0
+	I $G(PTHRN)="" S DEMOYN=0
+	I $G(PTLANG)="" S DEMOYN=0
+	I $G(RACEDSC)="" S DEMOYN=0
+	I $G(ETHNDSC)="" S DEMOYN=0
+	;I DEMOYN S C0QLIST("HasDemographics",DFN)=""
+	;E  S C0QLIST("FailedDemographics",DFN)=""
+	;S G1("Gender")=PTSEX
+	;S G1("DateOfBirth")=PTDOB
+	;S G1("HealthRecordNumber")=PTHRN
+	;S G1("LanguageSpoken")=$G(PTLANG)
+	;S G1("Race")=RACEDSC
+	;S G1("Ehtnicity")=$G(ETHNDSC)
+	S G1("Problem")=PBDESC
+	I PBDESC["No problems found" S C0QLIST(ZYR_"NoProblem",DFN)=""
+	E  S C0QLIST(ZYR_"HasProblem",DFN)=""
+	;S G1("Allergies")=ALDESC
+	I ALDESC["No Allergy" S C0QLIST(ZYR_"NoAllergy",DFN)=""
+	E  S C0QLIST(ZYR_"HasAllergy",DFN)=""
+	;I $D(MDITEM) D  ;
+	       ;. S C0QLIST("HasMed",DFN)=""
+	;E  S G1("NoMed",DFN)=""
+	;S G1("MedDescription")=$G(MDDESC)
+	Q
+	;
+NHIN	; SHOW THE NHIN ARRAY FOR THIS PATIENT
+	Q:DFN=137!14
+	D EN^C0CNHIN(.G,DFN,"")
+	ZWRITE G
+	K G
+	;
+	QUIT  ;end of WARD
+	;
+LOCPAT(PREFIX,LOC)	  ;retrieve active outpatients
+	; PREFIX WILL GO IN C0XLIST(PREFIX_"-PATIENT",DFN)=""
+	; LOC IS HOSPITAL LOCATION
+	S ULOC=$O(^SC("B",LOC,"")) ; IEN OF HOSPITAL LOCATION
+	I ULOC="" D  Q  ; OOPS
+	. W !,"HOSPITAL LOCATION NOT FOUND: ",LOC
+	S IDTE=9999999-DTE ; INVERSE DATE
+	N ZI
+	S ZI="" ; BEGIN AT LATEST DATE FOR THIS LOC IN VISIT FILE
+	F  S ZI=$O(^AUPNVSIT("AHL",ULOC,ZI)) Q:(ZI="")!(ZI>IDTE)  D  ; FOR EACH DATE
+	. W !,$$FMTE^XLFDT(9999999-ZI) ;B  ;
+	. I ZI="" Q  ;
+	. N ZJ S ZJ=""
+	. F  S ZJ=$O(^AUPNVSIT("AHL",ULOC,ZI,ZJ)) Q:ZJ=""  D  ; FOR EACH VISIT
+	. . S DFN=$$GET1^DIQ(9000010,ZJ,.05,"I") ; PATIENT
+	. . S C0QLIST(PREFIX_"Patient",DFN)=""
+	Q
+	;
+EPPAT(ZYR)	; BUILD ALL PATIENT LISTS FOR CLINICS
+	;
+	S DTE=3111000
+	S MUYR=ZYR
+	N ZC,ZN
+	S ZN=0
+	N ZI S ZI=0
+	F  S ZI=$O(^SC(ZI)) Q:+ZI=0  D  ; FOR EVERY HOSPITAL LOCATION
+	. I $$GET1^DIQ(44,ZI_",",2,"I")'="C" Q   ; NOT A CLINIC
+	. S ZC=$$GET1^DIQ(44,ZI_",",.01) ; NAME OF CLINIC
+	. S ZCIEN=ZI ; IEN OF CLINIC
+	. S ZN=ZN+1 ; COUNT OF CLINICS
+	. S PRE=MUYR_"-EP-"_ZC_"-"
+	. D LOCPAT(PRE,ZC)
+	W !,"NUMBER OF CLINICS: ",ZN
+	D FILE ; CREATE ALL THE EP PATIENT LISTS
+	Q
+	;
+DOEP	; DO EP COMPUTATIONS
+	S ZYR="MU12-"
+	N C0QPARM,C0QCLNC
+	D INIT("C0QPARM","EP") ; INITIALIZE PARAMETERS
+	K C0QLIST ; CLEAR THE LIST
+	N ZI S ZI=""
+	F  S ZI=$O(C0QPARM(ZI)) Q:ZI=""  D  ; FOR EACH EP
+	. S DTE=C0QPARM(ZI,"EPBeginDate") ; beginning of measurement period
+	. S EDTE=C0QPARM(ZI,"EPEndDate") ; end of measurement period -- tbd use this
+	. S C0QCLNC=C0QPARM(ZI,"CLINICS",1,1) ; only one clinic for now
+	. S PRE=ZYR_"EP-"_C0QCLNC_"-"
+	. D LOCPAT(PRE,C0QCLNC) ; GET THE PATIENTS
+	. I $D(DEBUG) ZWRITE C0QLIST
+	. M C0QLIST(ZYR_"EP-ALL-PATIENTS")=C0QLIST(PRE_"Patient")
+	S DFN=""
+	S ZYR=ZYR_"EP-"
+	F  S DFN=$O(C0QLIST(ZYR_"ALL-PATIENTS",DFN)) Q:DFN=""  D  ; EACH PATIENT
+	. D DEMO
+	. D PROBLEM
+	. D ALLERGY
+	. ;D MEDS
+	. D ERX
+	. D SMOKING
+	. D VITALS
+	D FILE ; FILE THE PATIENT LISTS
+	N C0QCIEN
+	S ZI=""
+	F  S ZI=$O(C0QPARM(ZI)) Q:ZI=""  D  ;
+	. S C0QCIEN=C0QPARM(ZI,"EPMeasurementSet") ; ien of measurement set
+	. D UPDATE^C0QUPDT(.G,C0QCIEN) ; UPDATE THE MU MEASUREMENT SET
+	Q
+	;
+DIS	;
+	N DFN,DTE,EXDTE S DTE=""
+	F  D  Q:DTE=""
+	. S DTE=$O(^DGPM("B",DTE))
+	. Q:'DTE
+	. ;Q:$P(DTE,".")<3110703
+	. Q:$P(DTE,".")<3111000  ; NEW BEGIN DATE FOR FISCAL YEAR 2012
+	. S EXDTE=$$FMTE^XLFDT(DTE)
+	. N PTFM S PTFM=""
+	. D
+	. . S PTFM=$O(^DGPM("B",DTE,PTFM))
+	. . Q:'PTFM
+	. . S DFN=$P(^DGPM(PTFM,0),U,3)
+	. . S C0QLIST(ZYR_"Patient",DFN)=""
+	. . D DEMO
+	. . D PROBLEM
+	. . D ALLERGY
+	. . D MEDS4
+	. . D RECON2
+	. . D ADVDIR
+	. . D SMOKING
+	. . D VITALS
+	. . ;D:$P(DTE,".")>3110912 VTE1
+	. . D VTE1
+	. . D COD
+	. . D EDTIME
+	. . I C0QPR D PRINT
+	. . I C0QSS D SS
+	. . I C0QPL D PATLIST
+	Q
+	;
+C0QPLF()	Q 1130580001.301 ; FILE NUMBER FOR C0Q PATIENT LIST FILE
+C0QALFN()	Q 1130580001.311 ; FILE NUMBER FOR C0Q PATIENT LIST PATIENT SUBFILE
+FILE	; FILE THE PATIENT LISTS TO C0Q PATIENT LIST
+	;
+	I '$D(C0QLIST) Q  ;
+	N LFN S LFN=$$C0QALFN()
+	N ZI,ZN
+	S ZI=""
+	F  S ZI=$O(C0QLIST(ZI)) Q:ZI=""  D  ;
+	. S ZN=$O(^C0Q(301,"CATTR",ZI,""))
+	. I ZN="" D  ; LIST NOT FOUND, CREATE IT
+	. . K C0QFDA
+	. . S FN=$$C0QPLF ; C0Q PATIENT LIST FILE
+	. . S C0QFDA(FN,"+1,",.01)=ZI
+	. . S C0QFDA(FN,"+1,",999)=ZI ; ATTRIBUTE
+	. . W !,"CREATING ",ZI
+	. . D UPDIE ; ADD THE RECORD
+	. . S ZN=$O(^C0Q(301,"CATTR",ZI,"")) ; THE NEW IEN
+	. ;I ZN="" D  Q  ; OOPS
+	. ;. W !,"ERROR, ATTRIBUTE NOT FOUND IN PATIENT LIST FILE:"_ZI
+	. ;S ZN=$$KLNCR(ZN) ; KILL AND RECREATE RECORD ZN
+	. N C0QNEW,C0QOLD,C0QRSLT
+	. S C0QNEW=$NA(C0QLIST(ZI)) ; THE NEW PATIENT LIST
+	. S C0QOLD=$NA(^C0Q(301,ZN,1,"B")) ; THE OLD PATIENT LIST
+	. D UNITY^C0QSET("C0QRSLT",C0QNEW,C0QOLD) ; FIND WHAT'S NEW
+	. N ZJ,ZK
+	. ; FIRST, DELETE THE OLD ONES - NO LONGER IN THE LIST
+	. K C0QFDA
+	. S ZJ=""
+	. F  S ZJ=$O(C0QRSLT(2,ZJ)) Q:ZJ=""  D  ; MARKED WITH A 2 FROM UNITY
+	. . S ZK=$O(@C0QOLD@(ZJ,"")) ; GET THE IEN OF THE RECORD TO DELETE
+	. . I ZK="" D  Q  ; OOPS SHOULDN'T HAPPEN
+	. . . W !,"INTERNAL ERROR FINDING A PATIENT TO DELETE"
+	. . . S $EC=",U1130580001,"  ; smh - instead of a BREAK
+	. . S C0QFDA(LFN,ZK_","_ZN_",",.01)="@"
+	. I $D(C0QFDA) D UPDIE ; PROCESS THE DELETIONS
+	. ; SECOND, PROCESS THE ADDITIONS
+	. K C0QFDA
+	. S ZJ="" S ZK=1
+	. F  S ZJ=$O(C0QRSLT(0,ZJ)) Q:ZJ=""  D  ; PATIENTS TO ADD ARE MARKED WITH 0
+	. . S C0QFDA(LFN,"+"_ZK_","_ZN_",",.01)=ZJ
+	. . S ZK=ZK+1
+	. I $D(C0QFDA) D UPDIE ; PROCESS THE ADDITIONS
+	;. Q
+	;. K C0QFDA
+	;. N ZJ,ZC
+	;. S ZJ="" S ZC=1
+	;. F  S ZJ=$O(C0QLIST(ZI,ZJ)) Q:ZJ=""  D  ; FOR EACH PAT IN LIST
+	;. . S C0QFDA(LFN,"?+"_ZC_","_ZN_",",.01)=ZJ
+	;. . S ZC=ZC+1
+	;. D UPDIE
+	;. W !,"FOUND:"_ZI
+	Q
+	;
+KLNCR(ZREC)	; KILL AND RECREATE RECORD ZREC IN PATIENT LIST FILE
+	;
+	N C0QFDA,ZFN,LIST,ATTR
+	S ZFN=$$C0QPLF() ; FILE NUMBER FOR C0Q PATIENT LIST FILE
+	D CLEAN^DILF
+	S LIST=$$GET1^DIQ(ZFN,ZREC_",",.01) ;  MEASURE NAME
+	S ATTR=$$GET1^DIQ(ZFN,ZREC_",",999) ; ATTRIBUTE
+	D CLEAN^DILF
+	K ZERR
+	S C0QFDA(ZFN,ZREC_",",.01)="@" ; GET READY TO DELETE THE MEASURE
+	D FILE^DIE(,"C0QFDA","ZERR") ; KILL THE SUBFILE
+	I $D(ZERR) S ZZERR=ZZERR ; ZZERR DOESN'T EXIST, INVOKE THE ERROR TRAP IF TASKED
+	;. W "ERROR",!
+	;. ZWR ZERR
+	;. B
+	K C0QFDA
+	S C0QFDA(ZFN,"+1,",.01)=LIST ; GET READY TO RECREATE THE RECORD
+	S C0QFDA(ZFN,"+1,",999)=ATTR ; ATTRIBUTE
+	D UPDIE ; CREATE THE SUBFILE
+	N ZR ; NEW IEN FOR THE RECORD
+	S ZR=$O(^C0Q(301,"CATTR",ATTR,""))
+	;
+	Q ZR
+	;
+UPDIE	; INTERNAL ROUTINE TO CALL UPDATE^DIE AND CHECK FOR ERRORS
+	K ZERR
+	D CLEAN^DILF
+	D UPDATE^DIE("","C0QFDA","","ZERR")
+	I $D(ZERR) S ZZERR=ZZERR ; ZZERR DOESN'T EXIST, INVOKE THE ERROR TRAP IF TASKED
+	;. W "ERROR",!
+	;. ZWR ZERR
+	;. B
+	K C0QFDA
+	Q
+	;
+	; WHAT FOLLOWS IS OLD CODE - DELETE WHEN THIS WORKS
+	;. . N PTNAME S PTNAME=$P(^DPT(DFN,0),U,1)
+	;. . S PTDOB=$$FMTE^XLFDT($P($G(^DPT(DFN,0)),U,3)) ;date of birth
+	;. . S PTSEX=$P($G(^DPT(DFN,0)),U,2) ;patient sex
+	;. . D PID^VADPT ;VADPT call to grab PISD based on PT Eligibility
+	;. . S PTHRN=$P($G(VA("PID")),U) ;health record number
+	;. . S PTRLANG=$P($G(^DPT(DFN,256000)),U) ;ptr to language file
+	;. . I $G(PTRLANG)'="" S PTLANG=$P(^DI(.85,PTRLANG,0),U) ;PLS extrnl
+	;. . S RACE=""
+	;. . F  D  Q:RACE=""
+	;. . . S RACE=$O(^DPT(DFN,.02,"B",RACE))
+	;. . . Q:'RACE
+	;. . . S RACEDSC=$P($G(^DIC(10,RACE,0)),U)
+	;. . N ETHNDSC
+	;. . N ETHNDSC S ETHNDSC=""
+	;. . S ETHN=""
+	;. . F  D  Q:ETHN=""
+	;. . . S ETHN=$O(^DPT(DFN,.06,"B",ETHN))
+	;. . . Q:'ETHN
+	;. . . S ETHNDSC=$P($G(^DIC(10.2,ETHN,0)),U)
+	;. . D LIST^ORQQPL(.PROBL,DFN,"A")
+	;. . S PBCNT=""
+	;. . F  S PBCNT=$O(PROBL(PBCNT)) Q:PBCNT=""  D
+	;. . . S PBDESC=$P(PROBL(PBCNT),U,2) ;problem description
+	;. . K PROBL
+	;. . D LIST^ORQQAL(.ALRGYL,DFN)
+	;. . S ALCNT=""
+	;. . F  S ALCNT=$O(ALRGYL(ALCNT)) Q:ALCNT=""  D
+	;. . . S ALDESC=$P(ALRGYL(ALCNT),U,2) ;allergy description
+	;. . K ALRGYL
+	;. . D COVER^ORWPS(.MEDSL,DFN)
+	;. . S MDCNT=""
+	;. . F  S MDCNT=$O(MEDSL(MDCNT)) Q:MDCNT=""  D
+	;. . . Q:$P(MEDSL(MDCNT),U,4)'="ACTIVE"  ;active medications only
+	;. . . S MDDESC=$P(MEDSL(MDCNT),U,2) ;medication description
+	;. . . S MDITEM=$P($G(MEDSL(MDCNT)),U,3)
+	;. . K MEDSL
+	;. . W !,"Discharge Date: ",EXDTE
+	;. . W !,DFN," ",PTNAME
+	;. . W !,"DOB: ",PTDOB," HRN: ",PTHRN
+	;. . W !,"Language Spoken: ",$G(PTLANG)
+	;. . W !,"Race: ",RACEDSC
+	;. . W !,"Ethnicity: ",ETHNDSC
+	;. . W !,"Problems: "
+	;. . W !,PBDESC
+	;. . W !,"Allergies: "
+	;. . W !,ALDESC
+	;. . W !,"Medications: "
+	;. . I $D(MDITEM) W !,"(",MDITEM,")",MDDESC E  W !,MDDESC
+	;. . W !
+	;Q
+	;
+	;
+	;
+	;
+END	;end of C0QPRML;
Index: qrda/C0Q/trunk/p/C0QNOTES.m
===================================================================
--- qrda/C0Q/trunk/p/C0QNOTES.m	(revision 1437)
+++ qrda/C0Q/trunk/p/C0QNOTES.m	(revision 1438)
@@ -1,4 +1,4 @@
-C0QNOTES	;GPL - Utility to look up patient notes  ;9/5/11 8:50pm
-	;;1.0;MU PACKAGE;;;Build 27
+C0QNOTES	;GPL - Utility to look up patient notes  ; 5/23/12 5:44pm
+	;;1.0;C0Q;;May 21, 2012;Build 43
 	;
 	;2011 George Lilly <glilly@glilly.net> - Licensed under the terms of the GNU
@@ -112,5 +112,5 @@
 	S GT(5,"HasMedRecon","Medication Reconcilation Complete")=""
 	W $$TXTALL(.G,.GT,2) ; CHECK ALL PATIENT 2'S NOTEST FOR SMOKING
-	ZWR G
+	ZWRITE G
 	Q
 	;
Index: qrda/C0Q/trunk/p/C0QPQRI.m
===================================================================
--- qrda/C0Q/trunk/p/C0QPQRI.m	(revision 1437)
+++ qrda/C0Q/trunk/p/C0QPQRI.m	(revision 1438)
@@ -1,4 +1,4 @@
-C0QPQRI	  ; GPL - GENERATES A PQRI XML FILE ;6/14/11  17:05
-	;;0.1;C0C;nopatch;noreleasedate;Build 27
+C0QPQRI	  ; GPL - GENERATES A PQRI XML FILE ; 5/23/12 2:42pm
+	;;1.0;C0Q;;May 21, 2012;Build 43
 	;Copyright 2011 George Lilly.  Licensed under the terms of the GNU
 	;General Public License See attached copy of the License.
@@ -100,5 +100,5 @@
 	;N GGG
 	S GGG="//submission/measure-group ID='C'/provider/pqri-measure" ;XPATH
-	D INSINNER^COCXPATH(ZARY,GGG,ZONE) ; INSERT XML
+	D INSINNER^C0CXPATH(ZARY,GGG,ZONE) ; INSERT XML
 	Q
 	;
Index: qrda/C0Q/trunk/p/C0QPRML.m
===================================================================
--- qrda/C0Q/trunk/p/C0QPRML.m	(revision 1437)
+++ qrda/C0Q/trunk/p/C0QPRML.m	(revision 1438)
@@ -1,4 +1,4 @@
 C0QPRML	;JJOH/ZAG/GPL - Patient Reminder List ;7/5/11 8:50pm
-	;;1.0;MU PACKAGE;;;Build 27
+	;;1.0;C0Q;;May 21, 2012;Build 33
 	;
 	;2011 Zach Gonzales<zach@linux.com> - Licensed under the terms of the GNU
Index: qrda/C0Q/trunk/p/C0QSET.m
===================================================================
--- qrda/C0Q/trunk/p/C0QSET.m	(revision 1437)
+++ qrda/C0Q/trunk/p/C0QSET.m	(revision 1438)
@@ -1,4 +1,4 @@
-C0QSET	;GPL - SET OPERATIONS ON LISTS ;818/11 8:50pm
-	;;1.0;MU PACKAGE;;;Build 27
+C0QSET	;GPL - SET OPERATIONS ON LISTS ;818/11 8:50pm ; 5/23/12 5:46pm
+	;;1.0;C0Q;;May 21, 2012;Build 43
 	;
 	;2011 George Lilly glilly@glilly.net - Licensed under the terms of the GNU
@@ -29,5 +29,5 @@
 	S B(4)=""
 	D UNITY("C","A","B")
-	ZWR C
+	ZWRITE C
 	Q
 	;
@@ -38,7 +38,7 @@
 	D UNITY("DELTA",PATS,MEDS)
 	W !,"PATIENTS WITH NO MEDS",!
-	ZWR DELTA(0,*)
+	ZWRITE DELTA(0,*)
 	W !,"BAD POINTERS IN THE MEDS FILE",!
-	ZWR DELTA(2,*)
+	ZWRITE DELTA(2,*)
 	Q
 	;
Index: qrda/C0Q/trunk/p/C0QUPDT.m
===================================================================
--- qrda/C0Q/trunk/p/C0QUPDT.m	(revision 1437)
+++ qrda/C0Q/trunk/p/C0QUPDT.m	(revision 1438)
@@ -1,4 +1,4 @@
-C0QUPDT	; GPL - Quality Reporting List Update Routines ;8/29/11  17:05
-	;;0.1;C0Q;nopatch;noreleasedate;Build 27
+C0QUPDT	; GPL - Quality Reporting List Update Routines ; 5/23/12 5:46pm
+	;;1.0;C0Q;;May 21, 2012;Build 43
 	;Copyright 2009 George Lilly.  Licensed under the terms of the GNU
 	;General Public License See attached copy of the License.
@@ -95,5 +95,5 @@
 	. ; FIRST PROCESS DELETIONS
 	. K C0QFDA ; CLEAR OUT THE FDA
-	. N ZG,ZIEN S ZG="" 
+	. N ZG,ZIEN S ZG=""
 	. F  S ZG=$O(C0QRSLT(2,ZG)) Q:ZG=""  D  ; FOR EACH DELETION
 	. . S ZIEN=$O(@C0QOLD@(ZG,"")) ; IEN OF THE ENTRY
@@ -104,5 +104,5 @@
 	. ; SECOND, PROCESS ADDITIONS
 	. K C0QFDA ; CLEAR OUT THE FDA
-	. N ZG,ZC S ZG="" S ZC=1 
+	. N ZG,ZC S ZG="" S ZC=1
 	. F  S ZG=$O(C0QRSLT(0,ZG)) Q:ZG=""  D  ; FOR EACH ADDITION
 	. . S C0QFDA($$C0QMMNFN(),"+"_ZC_","_ZII_","_MSET_",",.01)=ZG ; ADD THE ENTRY
@@ -147,5 +147,5 @@
 	. ; FIRST PROCESS DELETIONS
 	. K C0QFDA ; CLEAR OUT THE FDA
-	. N ZG,ZIEN S ZG="" 
+	. N ZG,ZIEN S ZG=""
 	. F  S ZG=$O(C0QRSLT(2,ZG)) Q:ZG=""  D  ; FOR EACH DELETION
 	. . S ZIEN=$O(@C0QOLD@(ZG,"")) ; IEN OF THE ENTRY
@@ -156,5 +156,5 @@
 	. ; SECOND, PROCESS ADDITIONS
 	. K C0QFDA ; CLEAR OUT THE FDA
-	. N ZG,ZC S ZG="" S ZC=1 
+	. N ZG,ZC S ZG="" S ZC=1
 	. F  S ZG=$O(C0QRSLT(0,ZG)) Q:ZG=""  D  ; FOR EACH ADDITION
 	. . S C0QFDA($$C0QMMDFN(),"+"_ZC_","_ZII_","_MSET_",",.01)=ZG ; ADD THE ENTRY
@@ -191,5 +191,5 @@
 	K ZERR
 	D CLEAN^DILF
-	ZWR C0QFDA
+	ZWRITE C0QFDA
 	D UPDATE^DIE("","C0QFDA","","ZERR")
 	I $D(ZERR) S ZZERR=ZZERR ; ZZERR DOESN'T EXIST, INVOKE THE ERROR TRAP IF TASKED
Index: qrda/C0Q/trunk/p/C0QUTIL.m
===================================================================
--- qrda/C0Q/trunk/p/C0QUTIL.m	(revision 1437)
+++ qrda/C0Q/trunk/p/C0QUTIL.m	(revision 1438)
@@ -1,79 +1,79 @@
-C0QUTIL ;JJOH/ZAG/GPL - Utilities for C0Q Package ;9/2/11 4:30pm
- ;;1.0;MU PACKAGE;;;Build 27
- ;
- ;2011 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.
- ;
-AGE(DFN) ; return current age in years and months
- ;
- Q:'$G(DFN)  ;quit if no there is no patient
- N DOB S DOB=$P(^DPT(+DFN,0),U,3) ;date of birth
- N YRS
- N DOD S DOD=+$G(^DPT(9,.35)) ;check for date of death
- I 'DOD D
- . N CDTE S CDTE=DT ;current date
- . S YRS=$E(CDTE,1,3)-$E(DOB,1,3)-($E(CDTE,4,7)<$E(DOB,4,7))
- E  D
- . S YRS=$E(DOD,1,3)-$E(DOB,1,3)-($E(DOD,4,7)<$E(DOB,4,7))
- ;
- ;Come back here and fix MONTHS and DAYS
- ;N CM S CM=+$E(DT,4,5) ;current month
- ;N CD S CD=+$E(DT,6,7) ;current day
- ;N BM S BM=+$E(DOB,4,5) ;birth month
- ;N BD S BD=+$E(DOB,6,7) ;birth day
- ;
- ;N DAYS S DAYS=""
- ;
- Q YRS ;_"y" gpl ..just want the number
- ;
- ;
-DTDIFF(ZD1,ZT1,ZD2,ZT2,SHOW) ; extrinsic which returns the number of minutes
- ; between 2 dates. ZD1 and ZD2 are fileman dates
- ; ZT1 AND ZT2 are valid times (military time) ie 20:10
- ; IF SHOW=1 DEBUGGING INTERMEDIATE VALUES WILL BE DISPLAYED
- I '$D(SHOW) S SHOW=0
- N GT1,GT2,GDT1,GDT2
- I ZT1[":" D  ;
- . S GT1=($P(ZT1,":",1)*3600)+($P(ZT1,":",2)*60) ; SECONDS
- . S GT2=($P(ZT2,":",1)*3600)+($P(ZT2,":",2)*60) ; SECONDS
- E  D  ;
- . S GT1=($E(ZT1,1,2)*3600)+($E(ZT1,3,4)*60)
- . S GT2=($E(ZT2,1,2)*3600)+($E(ZT2,3,4)*60)
- ;W:SHOW !,"SECONDS: ",GT1," ",GT2
- ;S %=GT1 D S^%DTC ; FILEMAN TIME
- ;S GDT1=ZD1_% ; FILEMAN DATE AND TIME
- ;S %=GT2 D S^%DTC ; FILEMAN TIME
- ;S GDT2=ZD2_% ; FILEMAN DATE AND TIME
- S GDT1=ZD1_"."_ZT1
- S GDT2=ZD2_"."_ZT2
- W:SHOW !,"FILEMAN: ",GDT1," ",GDT2
- N ZH1,ZH2
- S ZH1=$$FMTH^XLFDT(GDT1) ; $H FORMAT 
- S ZH2=$$FMTH^XLFDT(GDT2) ; $H FORMAT 
- W:SHOW !,"$H: ",ZH1," ",ZH2
- N ZSECS,ZMIN
- S ZSECS=$$HDIFF^XLFDT(ZH1,ZH2,2) ; DIFFERENCE IN $H
- W:SHOW !,"DIFF: ",ZSECS
- S ZMIN=ZSECS/60 ; DIFFERENCE IN MINUTES
- W:SHOW !,"MIN: ",ZMIN
- Q ZMIN
- ;
-DT(X) ; -- Returns FM date for X
- N Y,%DT S %DT="T",Y="" D:X'="" ^%DT
- Q Y
-     ;
-END ;end of C0QUTIL
+C0QUTIL	;JJOH/ZAG/GPL - Utilities for C0Q Package ;9/2/11 4:30pm
+	;;1.0;C0Q;;May 21, 2012;Build 43
+	;
+	;2011 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.
+	;
+AGE(DFN)	; return current age in years and months
+	;
+	Q:'$G(DFN)  ;quit if no there is no patient
+	N DOB S DOB=$P(^DPT(+DFN,0),U,3) ;date of birth
+	N YRS
+	N DOD S DOD=+$G(^DPT(9,.35)) ;check for date of death
+	I 'DOD D
+	. N CDTE S CDTE=DT ;current date
+	. S YRS=$E(CDTE,1,3)-$E(DOB,1,3)-($E(CDTE,4,7)<$E(DOB,4,7))
+	E  D
+	. S YRS=$E(DOD,1,3)-$E(DOB,1,3)-($E(DOD,4,7)<$E(DOB,4,7))
+	;
+	;Come back here and fix MONTHS and DAYS
+	;N CM S CM=+$E(DT,4,5) ;current month
+	;N CD S CD=+$E(DT,6,7) ;current day
+	;N BM S BM=+$E(DOB,4,5) ;birth month
+	;N BD S BD=+$E(DOB,6,7) ;birth day
+	;
+	;N DAYS S DAYS=""
+	;
+	Q YRS ;_"y" gpl ..just want the number
+	;
+	;
+DTDIFF(ZD1,ZT1,ZD2,ZT2,SHOW)	; extrinsic which returns the number of minutes
+	; between 2 dates. ZD1 and ZD2 are fileman dates
+	; ZT1 AND ZT2 are valid times (military time) ie 20:10
+	; IF SHOW=1 DEBUGGING INTERMEDIATE VALUES WILL BE DISPLAYED
+	I '$D(SHOW) S SHOW=0
+	N GT1,GT2,GDT1,GDT2
+	I ZT1[":" D  ;
+	. S GT1=($P(ZT1,":",1)*3600)+($P(ZT1,":",2)*60) ; SECONDS
+	. S GT2=($P(ZT2,":",1)*3600)+($P(ZT2,":",2)*60) ; SECONDS
+	E  D  ;
+	. S GT1=($E(ZT1,1,2)*3600)+($E(ZT1,3,4)*60)
+	. S GT2=($E(ZT2,1,2)*3600)+($E(ZT2,3,4)*60)
+	;W:SHOW !,"SECONDS: ",GT1," ",GT2
+	;S %=GT1 D S^%DTC ; FILEMAN TIME
+	;S GDT1=ZD1_% ; FILEMAN DATE AND TIME
+	;S %=GT2 D S^%DTC ; FILEMAN TIME
+	;S GDT2=ZD2_% ; FILEMAN DATE AND TIME
+	S GDT1=ZD1_"."_ZT1
+	S GDT2=ZD2_"."_ZT2
+	W:SHOW !,"FILEMAN: ",GDT1," ",GDT2
+	N ZH1,ZH2
+	S ZH1=$$FMTH^XLFDT(GDT1) ; $H FORMAT 
+	S ZH2=$$FMTH^XLFDT(GDT2) ; $H FORMAT 
+	W:SHOW !,"$H: ",ZH1," ",ZH2
+	N ZSECS,ZMIN
+	S ZSECS=$$HDIFF^XLFDT(ZH1,ZH2,2) ; DIFFERENCE IN $H
+	W:SHOW !,"DIFF: ",ZSECS
+	S ZMIN=ZSECS/60 ; DIFFERENCE IN MINUTES
+	W:SHOW !,"MIN: ",ZMIN
+	Q ZMIN
+	;
+DT(X)	; -- Returns FM date for X
+	N Y,%DT S %DT="T",Y="" D:X'="" ^%DT
+	Q Y
+	    ;
+END	;end of C0QUTIL