Changeset 1438 for qrda/C0Q/trunk/p
- Timestamp:
- May 25, 2012, 5:55:11 PM (13 years ago)
- Location:
- qrda/C0Q/trunk/p
- Files:
-
- 1 added
- 15 edited
-
C0QERTIM.m (modified) (2 diffs)
-
C0QGMRAD.m (modified) (1 diff)
-
C0QGMTSA.m (modified) (1 diff)
-
C0QGMTSG.m (modified) (1 diff)
-
C0QHF.m (modified) (1 diff)
-
C0QIMMUN.m (modified) (3 diffs)
-
C0QINIT.m (modified) (1 diff)
-
C0QKIDS.m (added)
-
C0QMAIN.m (modified) (1 diff)
-
C0QMU12.m (modified) (1 diff)
-
C0QNOTES.m (modified) (2 diffs)
-
C0QPQRI.m (modified) (2 diffs)
-
C0QPRML.m (modified) (1 diff)
-
C0QSET.m (modified) (3 diffs)
-
C0QUPDT.m (modified) (6 diffs)
-
C0QUTIL.m (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
qrda/C0Q/trunk/p/C0QERTIM.m
r1364 r1438 1 C0QERTIM ; Time from admission to leaving a hospital location ; 2 ;; 0.1;C0Q;;;Build 271 C0QERTIM ; Time from admission to leaving a hospital location ; 5/23/12 2:26pm 2 ;;1.0;C0Q;;May 21, 2012;Build 43 3 3 EN ;Get Location 4 4 S DIC=42,DIC(0)="AEMQ" D ^DIC I Y<1 G EXIT … … 56 56 K POP,D0,D1,DIFFDAY,MINUTES,MID,MEDIAN,PATIENT,^TMP($J) 57 57 Q 58 -
qrda/C0Q/trunk/p/C0QGMRAD.m
r1364 r1438 1 1 C0QGMRAD ;HIRMFO/RM,WAA-UTILITY TO GATHER PATIENT DATA ;1/15/98 13:47 2 ;; 4.0;Adverse Reaction Tracking;**2,10**;Mar 29, 1996;Build 272 ;;1.0;C0Q;;May 21, 2012;Build 43 3 3 EN1 ; ENTRY TO GATHER PATIENT A/AR DATA 4 4 ;INPUT VARIABLES: -
qrda/C0Q/trunk/p/C0QGMTSA.m
r1364 r1438 1 1 C0QGMTSA ; SLC/DLT,KER - Brief Adverse Reaction/Allergy ; 02/27/2002 2 ;; 2.7;Health Summary;**28,49**;Oct 20, 1995;Build 272 ;;1.0;C0Q;;May 21, 2012;Build 43 3 3 ; 4 4 ; External References -
qrda/C0Q/trunk/p/C0QGMTSG.m
r1364 r1438 1 1 C0QGMTSG ; SLC/DLT,KER - Allergies ; 01/06/2003 2 ;; 2.7;Health Summary;**9,28,49,58**;Oct 20, 1995;Build 272 ;;1.0;C0Q;;May 21, 2012;Build 43 3 3 ; 4 4 ; External References -
qrda/C0Q/trunk/p/C0QHF.m
r1364 r1438 1 1 C0QHF ; GPL - Health Factor Utility Routines ;9/02/11 17:05 2 ;; 0.1;C0Q;nopatch;noreleasedate;Build 272 ;;1.0;C0Q;;May 21, 2012;Build 43 3 3 ;Copyright 2011 George Lilly. Licensed under the terms of the GNU 4 4 ;General Public License See attached copy of the License. -
qrda/C0Q/trunk/p/C0QIMMUN.m
r1364 r1438 1 C0QIMMUN ;Prep Immunization Order data for HL7 Message creation ; 2 ;; 0.1;C0Q;nopatch;noreleasedate;Build 271 C0QIMMUN ;Prep Immunization Order data for HL7 Message creation ; 5/23/12 5:40pm 2 ;;1.0;C0Q;;May 21, 2012;Build 43 3 3 ; ^XTMP("C0QIMMUN",0)=purge date^create date 4 4 ; ^XTMP("C0QIMMUN",order_date,order#,item_name)=item_value 5 5 ; ^XTMP("C0QIMMUN","LASTORDR")=last order processed 6 ; Changed by VEN/SMH to add timeout to the locks on May 23 2012 6 7 FIND ; Find the next set of immunization orders 7 8 N X1,X2,X,%,%DT,%H,%T,NOW,ORDER,LASTORDR,SUBSC,DIR 8 9 S LASTORDR=+$G(^XTMP("C0QIMMUN","LASTORDR")) 10 N C0QFAIL S C0QFAIL=0 ; Lock fail flag 9 11 W !,"The ""Last Order"" from which to begin checking for Immunization orders is: ",LASTORDR 10 12 S DIR("A")="Do you want to reset that value" … … 15 17 . D:Y>0 16 18 . . S LASTORDR=+Y 17 . . L +^XTMP("C0QIMMUN") 19 . . L +^XTMP("C0QIMMUN"):0 20 . . E S C0QFAIL=1 QUIT 18 21 . . S X1=DT,X2=365 D C^%DTC 19 22 . . S ^XTMP("C0QIMMUN",0)=X_U_DT … … 22 25 . . Q 23 26 . Q 27 I C0QFAIL W !,"Failed to acquire lock, exiting..." QUIT 24 28 S DIR("A")="Ready to prep more immunization orders for HL7 messages" 25 29 S DIR(0)="Y",DIR("B")="YES" D ^DIR Q:Y'=1 26 L +^XTMP("C0QIMMUN") 30 L +^XTMP("C0QIMMUN"):0 31 E W !,"Failed to acquire lock; exiting..." QUIT 27 32 I '$D(^XTMP("C0QIMMUN",0)) D 28 33 . S X1=DT,X2=365 D C^%DTC -
qrda/C0Q/trunk/p/C0QINIT.m
r1364 r1438 1 C0QINIT ; GPL - Quality Reporting Initialization Routines ;12/01/11 17:052 ;;0.1;C0Q;nopatch;noreleasedate;Build 27 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 C0QQFN() 23 C0QMFN() 24 C0QMMFN() 25 C0QMMNFN() 26 C0QMMDFN() 27 RLSTFN() 28 RLSTPFN() 29 C0QALFN() 30 31 COPYQ 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 UPDIE 64 65 66 ZWRC0QFDA67 68 69 70 71 72 1 C0QINIT ; GPL - Quality Reporting Initialization Routines ; 5/23/12 5:43pm 2 ;;1.0;C0Q;;May 21, 2012;Build 43 3 ;Copyright 2011 George Lilly. Licensed under the terms of the GNU 4 ;General Public License See attached copy of the License. 5 ; 6 ;This program is free software; you can redistribute it and/or modify 7 ;it under the terms of the GNU General Public License as published by 8 ;the Free Software Foundation; either version 2 of the License, or 9 ;(at your option) any later version. 10 ; 11 ;This program is distributed in the hope that it will be useful, 12 ;but WITHOUT ANY WARRANTY; without even the implied warranty of 13 ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 ;GNU General Public License for more details. 15 ; 16 ;You should have received a copy of the GNU General Public License along 17 ;with this program; if not, write to the Free Software Foundation, Inc., 18 ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. 19 ; 20 Q 21 ; 22 C0QQFN() Q 1130580001.101 ; FILE NUMBER FOR C0Q QUALITY MEASURE FILE 23 C0QMFN() Q 1130580001.201 ; FILE NUMBER FOR C0Q MEASUREMENT FILE 24 C0QMMFN() Q 1130580001.2011 ; FN FOR MEASURE SUBFILE 25 C0QMMNFN() Q 1130580001.20111 ; FN FOR NUMERATOR SUBFILE 26 C0QMMDFN() Q 1130580001.20112 ; FN FOR DENOMINATOR SUBFILE 27 RLSTFN() Q 810.5 ; FN FOR REMINDER PATIENT LIST FILE 28 RLSTPFN() Q 810.53 ; FN FOR REMINDER PATIENT LIST PATIENT SUBFILE 29 C0QALFN() Q 1130580001.311 ; FILE NUMBER FOR C0Q PATIENT LIST PATIENT SUBFILE ; 30 ; 31 COPYQ ; INTERACTIVE COPY OF A QUALITY MEASURE 32 N FN 33 S FN=$$C0QQFN 34 S DIC=FN,DIC(0)="AEMQ" D ^DIC 35 I Y<1 Q ; EXIT 36 S C0QIEN=$P(Y,U) 37 ;N G,ZWP 38 D GETS^DIQ(FN,C0QIEN,"**","EI","G") 39 M ZWP=G(FN,C0QIEN_",",.61) 40 ; GET READY TO CREATE THE NEW COPY 41 ; FIRST FIND OUT THE NEW NAME 42 N QNAME 43 S QNAME=G(FN,C0QIEN_",",.01,"E") 44 S DIR(0)="F^3:240" 45 S DIR("A")="New Measure Name" 46 S DIR("B")=QNAME 47 D ^DIR 48 I Y="^" Q ; 49 N QNEW 50 S QNEW=Y 51 K C0QFDA 52 N ZI S ZI="" 53 F S ZI=$O(G(FN,C0QIEN_",",ZI)) Q:ZI="" D ; FOR EACH FIELD 54 . I ZI=.01 D Q ; THE NEW NAME 55 . . S C0QFDA(FN,"+1,",.01)=QNEW ; NEW MEASURE NAME 56 . I ZI=3.1 Q ; SKIP THE COMPUTED FIELD 57 . S C0QFDA(FN,"+1,",ZI)=G(FN,C0QIEN_",",ZI,"I") 58 D UPDIE ; CREATE THE NEW RECORD 59 S DIE=$$C0QQFN ; GET READY TO EDIT IT 60 D EN^DIB ; EDIT THE NEW RECORD 61 Q 62 ; 63 UPDIE ; INTERNAL ROUTINE TO CALL UPDATE^DIE AND CHECK FOR ERRORS 64 K ZERR 65 D CLEAN^DILF 66 ZWRITE C0QFDA 67 D UPDATE^DIE("","C0QFDA","","ZERR") 68 I $D(ZERR) S ZZERR=ZZERR ; ZZERR DOESN'T EXIST, 69 ; INVOKE THE ERROR TRAP IF TASKED 70 K C0QFDA 71 Q 72 ; -
qrda/C0Q/trunk/p/C0QMAIN.m
r1364 r1438 1 1 C0QMAIN ; GPL - Quality Reporting Main Processing ;10/13/10 17:05 2 ;; 0.1;C0Q;nopatch;noreleasedate;Build 272 ;;1.0;C0Q;;May 21, 2012;Build 43 3 3 ;Copyright 2009 George Lilly. Licensed under the terms of the GNU 4 4 ;General Public License See attached copy of the License. -
qrda/C0Q/trunk/p/C0QMU12.m
r1364 r1438 1 C0Q PRML ;JJOH/ZAG/GPL - Patient Reminder List ;7/5/11 8:50pm2 ;;1.0;MU PACKAGE;;;Build 27 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 C0QPFN() 25 C0QPCFN() 26 C0QMFN() 27 C0QMMFN() 28 INIT(ZARY,ZTYP) 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 BUILD 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 . I C0QSS ZWRGRSLT80 81 82 83 84 85 86 87 88 INITCLST 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 ALL 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 DEMO 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 PROBLEM 162 163 164 165 166 167 168 169 170 171 ALLERGY 172 173 174 175 176 177 178 179 180 181 182 MEDS4 183 184 185 186 187 188 189 190 191 192 193 194 195 . S C0QLIST(ZYR_"HasMed",DFN)="" 196 197 198 199 200 201 202 203 204 205 206 RECON 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 RECON2 232 233 234 235 236 237 238 239 ERX 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 ADVDIR 257 258 259 260 261 262 263 264 265 266 SMOKING 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 VITALS 427 428 429 430 431 432 433 434 435 436 437 VTE1 438 439 440 441 E S C0QLIST(ZYR_"NoVTE24",DFN)="" 442 443 444 COD 445 446 447 448 449 EDTIME 450 451 452 453 454 455 456 457 458 459 460 ICUPAT 461 462 463 464 465 466 467 468 469 470 471 472 FILTER 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 ED1 513 514 515 516 517 ED2 518 519 520 521 522 DOTIME(ZHF) 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 DOTIME2(ZHF) 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 RPATLN(ZLST) 647 648 649 650 651 652 653 PATLN(ZATTR) 654 655 656 657 658 659 660 INLIST(ZLIST,DFN) 661 662 663 664 665 666 667 668 669 PRINT 670 671 672 673 674 675 676 677 678 679 680 681 682 683 684 685 686 SS 687 688 689 690 691 I $D(EXDTE) D;692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 PATLIST 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 NHIN 746 747 748 ZWRG749 750 751 752 753 LOCPAT(PREFIX,LOC) 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771 EPPAT(ZYR) 772 773 774 775 776 777 778 779 780 781 782 783 784 785 786 787 788 789 DOEP 790 791 792 793 794 795 796 797 798 799 800 801 . I $D(DEBUG) ZWRC0QLIST802 803 804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 821 DIS ;822 823 824 825 826 827 . Q:$P(DTE,".")<3111000; NEW BEGIN DATE FOR FISCAL YEAR 2012828 829 830 831 832 833 834 835 836 837 838 839 840 841 842 843 844 845 846 847 848 849 850 851 852 C0QPLF() 853 C0QALFN() 854 FILE 855 856 857 858 859 860 861 862 863 864 865 866 867 868 869 870 871 872 873 874 875 876 877 878 879 880 881 882 883 884 885 . . . B 886 887 888 889 890 891 892 893 894 895 896 897 898 899 900 901 902 903 904 905 906 KLNCR(ZREC) 907 908 909 910 911 912 913 914 915 916 917 918 919 920 921 922 923 924 925 926 927 928 929 930 UPDIE 931 932 933 934 935 936 937 938 939 940 941 942 943 944 945 946 947 948 949 950 951 952 953 954 955 956 957 958 959 960 961 962 963 964 965 966 967 968 969 970 971 972 973 974 975 976 977 978 979 980 981 982 983 984 985 986 987 988 989 990 991 992 993 994 995 996 END 1 C0QMU12 ;JJOH/ZAG/GPL - Patient Reminder List ; 5/23/12 5:43pm 2 ;;1.0;C0Q;;May 21, 2012;Build 43 3 ; 4 ;2011 Zach Gonzales<zach@linux.com> - Licensed under the terms of the GNU 5 ;General Public License See attached copy of the License. 6 ; 7 ;This program is free software; you can redistribute it and/or modify 8 ;it under the terms of the GNU General Public License as published by 9 ;the Free Software Foundation; either version 2 of the License, or 10 ;(at your option) any later version. 11 ; 12 ;This program is distributed in the hope that it will be useful, 13 ;but WITHOUT ANY WARRANTY; without even the implied warranty of 14 ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15 ;GNU General Public License for more details. 16 ; 17 ;You should have received a copy of the GNU General Public License along 18 ;with this program; if not, write to the Free Software Foundation, Inc., 19 ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. 20 ; 21 ; GPL - THIS ROUTINE IS A COPY OF JJOHMU11 THAT HAS BEEN MODIFIED 22 ; FOR MEANINGFUL USE CALCULATION FOR FISCAL YEAR 2012 AT OROVILLE HOSPITAL 23 ; 24 C0QPFN() Q 1130580001.401 ; PARAMETER FILE 25 C0QPCFN() Q 1130580001.411 ; CLINIC SUBFILE 26 C0QMFN() Q 1130580001.201 ; FILE NUMBER FOR C0Q MEASUREMENT FILE 27 C0QMMFN() Q 1130580001.2011 ; FN FOR MEASURE SUBFILE 28 INIT(ZARY,ZTYP) ; INITIALIZE THE PARAMETERS FOR BUILDING PATIENT LISTS 29 ; ZARY IS PASSED BY NAME 30 ; ZTYP IS "INP" OR "EP" 31 N ZMU S ZMU="MU12" ; THIS IS THE ONLY HARD CODED VALUE LEFT 32 ; TBD - CHANGE IT TO A READ FROM SYSTEM PARAMETERS 33 K @ZARY ; CLEAR RETURN ARRAY 34 N ZIEN,ZCNT,ZX 35 I $O(^C0Q(401,"MUTYP",ZMU,ZTYP,""))="" D Q ; OOPS NO RECORD THERE 36 . W !,"ERROR, NO PARAMETERS AVAILABLE" 37 S ZIEN="" 38 S ZCNT=0 39 F S ZIEN=$O(^C0Q(401,"MUTYP",ZMU,ZTYP,ZIEN)) Q:ZIEN="" D ; 40 . S ZCNT=ZCNT+1 41 . S @ZARY@(ZCNT,"MU")=$$GET1^DIQ($$C0QPFN,ZIEN_",",.02) 42 . S @ZARY@(ZCNT,"TYPE")=$$GET1^DIQ($$C0QPFN,ZIEN_",",.03) 43 . S ZX=$$GET1^DIQ($$C0QPFN,ZIEN_",",1,"I") 44 . S @ZARY@(ZCNT,"InpatientMeasurementSet")=ZX 45 . S @ZARY@(ZCNT,"InpatientBeginDate")=$$GET1^DIQ($$C0QMFN,ZX_",",.02,"I") 46 . S @ZARY@(ZCNT,"InpatientEndDate")=$$GET1^DIQ($$C0QMFN,ZX_",",.03,"I") 47 . S @ZARY@(ZCNT,"InpatientQualitySet")=$$GET1^DIQ($$C0QPFN,ZIEN_",",1.1,"I") 48 . S ZX=$$GET1^DIQ($$C0QPFN,ZIEN_",",2,"I") 49 . S @ZARY@(ZCNT,"EPMeasurementSet")=ZX 50 . S @ZARY@(ZCNT,"EPBeginDate")=$$GET1^DIQ($$C0QMFN,ZX_",",.02,"I") 51 . S @ZARY@(ZCNT,"EPEndDate")=$$GET1^DIQ($$C0QMFN,ZX_",",.03,"I") 52 . S @ZARY@(ZCNT,"EPQualitySet")=$$GET1^DIQ($$C0QPFN,ZIEN_",",2.1,"I") 53 . S @ZARY@(ZCNT,"InpatientQualitySet")=$$GET1^DIQ($$C0QPFN,ZIEN_",",1.1,"I") 54 . D CLEAN^DILF 55 . D LIST^DIC($$C0QPCFN,","_ZIEN_",",".01I") 56 . I $D(^TMP("DIERR",$J)) D Q ; ERROR READING CLINIC LIST 57 . . W !,"ERROR READING CLINIC PARAMETER LIST" 58 . M @ZARY@(ZCNT,"CLINICS")=^TMP("DILIST",$J) 59 ; 60 Q 61 ; 62 BUILD ; CALL ALL AND DIS AND BUILD THE GRSLT ARRAY or print or create 63 ; patient lists 64 ;N GRSLT ; ARRAY FOR RESULTS 65 I '$D(C0QSS) S C0QSS=0 ;default don't build spreadsheet array 66 I '$D(C0QPR) S C0QPR=0 ;default don't print out results 67 I '$D(C0QPL) S C0QPL=1 ;default do create patient lists 68 S ZYR="MU12-" 69 D INITCLST ; initialize C0QLIST 70 N G1 ; ONE SET OF VALUES - RNF1 FORMAT 71 N C0QPARM 72 D INIT("C0QPARM","INP") ; initialize inpatient parms 73 I $O(C0QPARM(""))="" D Q ; no parms for inpatient 74 . W !,"No inpatient parameters" 75 N ZDIV S ZDIV="" 76 F S ZDIV=$O(C0QPARM(ZDIV)) Q:ZDIV="" D ; for each inpatient division 77 . D ALL ; all currently admitted patients in the hospital 78 . D DIS ; all patients discharged since the reporting period began 79 . I C0QSS ZWRITE GRSLT 80 . ;D ICUPAT ; GENERATE ICU PATIENT LIST 81 . I C0QPL D ; 82 . . D FILE ; FILE THE PATIENT LISTS 83 . . D UPDATE^C0QUPDT(.G,C0QPARM(ZDIV,"InpatientMeasurementSet")) ; 84 . . D UPDATE^C0QUPDT(.G,C0QPARM(ZDIV,"InpatientQualitySet")) ; 85 . K C0QLIST 86 Q 87 ; 88 INITCLST ; initialize C0QLIST 89 ; INITIALIZE LISTS 90 ; this is done so that if there are no matching patients, the patient list 91 ; will be zeroed out 92 K C0QLIST 93 S C0QLIST(ZYR_"HasDemographics")="" 94 S C0QLIST(ZYR_"Patient")="" 95 S C0QLIST(ZYR_"HasProblem")="" 96 S C0QLIST(ZYR_"HasAllergy")="" 97 S C0QLIST(ZYR_"HasMed")="" 98 S C0QLIST(ZYR_"HasVitalSigns")="" 99 S C0QLIST(ZYR_"HasMedOrders")="" 100 S C0QLIST(ZYR_"HasSmokingStatus")="" 101 Q 102 ; 103 ALL ;retrieve active inpatients 104 N WARD S WARD="" 105 F D Q:WARD="" 106 . S WARD=$O(^DIC(42,"B",WARD)) ;ward name 107 . Q:WARD="" 108 . N WIEN S WIEN="" 109 . F S WIEN=$O(^DIC(42,"B",WARD,WIEN)) Q:'WIEN D ;wards IEN 110 . . S WARDNAME=$P(^DIC(42,WIEN,0),U,2) ;ward name 111 . . N DFN,RB S DFN="" 112 . . F S DFN=$O(^DPT("CN",WARD,+DFN)) Q:'DFN D ;DFN of patient on ward 113 . . . D DEMO 114 . . . D PROBLEM 115 . . . D ALLERGY 116 . . . D MEDS4 117 . . . D RECON2 118 . . . D ADVDIR 119 . . . D SMOKING 120 . . . D VITALS 121 . . . D VTE1 122 . . . D COD 123 . . . D EDTIME 124 . . . I C0QPR D PRINT 125 . . . I C0QSS D SS 126 . . . I C0QPL D PATLIST 127 Q 128 ; 129 DEMO ; patient demographics 130 K PTDOB 131 N PTNAME,PTSEX,PTHRN,PTRLANG,PTLANG,RACE,RACEDSC,ETHN,ETHNDSC,RB 132 S PTNAME=$P(^DPT(DFN,0),U) ;patient name 133 S PTDOB=$$FMTE^XLFDT($P($G(^DPT(DFN,0)),U,3)) ;date of birth 134 S PTSEX=$P($G(^DPT(DFN,0)),U,2) ;patient sex 135 D PID^VADPT ;VADPT call to grab PISD based on PT Eligibility 136 S PTHRN=$P($G(VA("PID")),U) ;health record number 137 S PTRLANG=$P($G(^DPT(DFN,256000)),U) ;ptr to language file 138 I $G(PTRLANG)'="" S PTLANG=$P(^DI(.85,PTRLANG,0),U) ;PLS extrnl 139 S RACE="" 140 F D Q:RACE="" 141 . S RACE=$O(^DPT(DFN,.02,"B",RACE)) ;race code IEN 142 . Q:'RACE 143 . S RACEDSC=$P($G(^DIC(10,RACE,0)),U) ;race description 144 S ETHN="" 145 F D Q:ETHN="" 146 . S ETHN=$O(^DPT(DFN,.06,"B",ETHN)) ;ethnicity IEN 147 . Q:'ETHN 148 . S ETHNDSC=$P($G(^DIC(10.2,ETHN,0)),U) ;ethnincity description 149 S RB=$P($G(^DPT(DFN,.101)),U) ;room and bed 150 N DEMOYN S DEMOYN=1 151 I $G(PTSEX)="" S DEMOYN=0 152 I $G(PTDOB)="" S DEMOYN=0 153 I $G(PTHRN)="" S DEMOYN=0 154 I $G(PTLANG)="" S DEMOYN=0 155 I $G(RACEDSC)="" S DEMOYN=0 156 I $G(ETHNDSC)="" S DEMOYN=0 157 I DEMOYN S C0QLIST(ZYR_"HasDemographics",DFN)="" 158 E S C0QLIST(ZYR_"FailedDemographics",DFN)="" 159 Q 160 ; 161 PROBLEM ; PATIENT PROBLEMS 162 D LIST^ORQQPL(.PROBL,DFN,"A") 163 S PBCNT="" 164 F S PBCNT=$O(PROBL(PBCNT)) Q:PBCNT="" D 165 . S PBDESC=$P(PROBL(PBCNT),U,2) ;problem description 166 I PBDESC["No problems found" S C0QLIST(ZYR_"NoProblem",DFN)="" 167 E S C0QLIST(ZYR_"HasProblem",DFN)="" 168 K PROBL 169 Q 170 ; 171 ALLERGY ; ALLERGY LIST 172 ; WANT TO CHANGE ALLERGIES FOR 2012 TO POPULATE THE C0QLIST DIRECTLY. GPL 173 D LIST^ORQQAL(.ALRGYL,DFN) 174 S ALCNT="" 175 F S ALCNT=$O(ALRGYL(ALCNT)) Q:ALCNT="" D 176 . S ALDESC=$P(ALRGYL(ALCNT),U,2) ;allergy description 177 I ALDESC["No Allergy" S C0QLIST(ZYR_"NoAllergy",DFN)="" 178 E S C0QLIST(ZYR_"HasAllergy",DFN)="" 179 K ALRGYL 180 Q 181 ; 182 MEDS4 ; USE OCL^PSOORRL TO GET ALL MEDS 183 ; DELETED MEDS, MEDS2, AND MEDS3 FOR 2012 TO USE ONLY MEDS4 184 N BEG,END 185 S BEG=$$DT^C0QUTIL("JULY 3,2011") 186 S END=$$DT^C0QUTIL("NOW") 187 D OCL^PSOORRL(DFN,BEG,END) ;DBIA #2400 188 N C0QMEDS 189 M C0QMEDS=^TMP("PS",$J) ; MEDS RETURNED FROM CALL 190 N FOUND 191 N ZI 192 I '$D(C0QMEDS(1)) D Q ; QUIT IF NO MEDS 193 . S C0QLIST(ZYR_"NoMed",DFN)="" 194 E D ; HAS MEDS 195 . S C0QLIST(ZYR_"HasMed",DFN)="" 196 S ZI="" S FOUND=0 197 F S ZI=$O(C0QMEDS(ZI)) Q:ZI="" D ; FOR EACH MED 198 . N ZM 199 . S ZM=$G(C0QMEDS(ZI,0)) ;THE MEDICATION 200 . I $P($P(ZM,"^",1),";",2)="I" D ; IE 1U;I FOR AN INPATIENT UNIT DOSE 201 . . S FOUND=1 202 I FOUND S C0QLIST(ZYR_"HasMedOrders",DFN)="" ; MET CPOE MEASURE 203 E S C0QLIST(ZYR_"NoMedOrders",DFN)="" 204 Q 205 ; 206 RECON ; MEDICATIONS RECONCILIATION 207 ; WANT TO SIMPLIFY MEDS RECON FOR 2012. GPL 208 ; 209 I $$HASNTYN^C0QNOTES("MED/SURG NURSING ADMISSION ASSESSMENT",DFN) D ; 210 . S C0QLIST(ZYR_"XferOfCare",DFN)="" ; transfer of care patient 211 N HASRECON S HASRECON=0 212 N GT,G 213 S GT(4,"HasMedRecon","MEDICATION RECONCILIATION COMPLET")="" 214 S GT(5,"HasMedRecon","Medication Reconcilation Complete")="" 215 I $$TXTALL^C0QNOTES(.G,.GT,DFN) D ; SEARCH ALL NOTES FOR MED RECON 216 . S HASRECON=1 217 ;N ZT 218 ;S ZT="MEDICATION RECONCILIATION COMPLET" 219 ;I $$NTTXT^C0QNOTES("ER NURSE NOTE",ZT,DFN) D ; 220 ;. S HASRECON=1 221 ;E D ; 222 ;. S ZT="Medication Reconcilation Complete" 223 ;. I $$NTTXT^C0QNOTES("MED/SURG NURSING ADMISSION ASSESSMENT",ZT,DFN) D ; 224 ;. . S HASRECON=1 225 ;I $$HFYN^C0QHF("MEDS HAVE BEEN REVIEWED",DFN) S HASRECON=1 226 I HASRECON D ; 227 . S C0QLIST(ZYR_"HasMedRecon",DFN)="" 228 E S C0QLIST(ZYR_"NoMedRecon",DFN)="" 229 Q 230 ; 231 RECON2 ; USE HEALTH FACTORS FOR MEDICATION RECONCILIATION 232 I $$HASNTYN^C0QNOTES("MED/SURG NURSING ADMISSION ASSESSMENT",DFN) D ; 233 . S C0QLIST(ZYR_"XferOfCare",DFN)="" ; transfer of care patient 234 I $$HFYN^C0QHF(DFN,"Medication Reconciliation Completed: Yes") D ; 235 . S C0QLIST(ZYR_"HasMedRecon",DFN)="" 236 E S C0QLIST(ZYR_"NoMedRecon",DFN)="" 237 Q 238 ; 239 ERX ; FOR EP, WE LOOK AT ERX MEDS 240 N ZI S ZI="" 241 N ZERX S ZERX=$NA(^PS(55,DFN,"NVA")) 242 F S ZI=$O(@ZERX@(ZI)) Q:ZI="" D ; 243 . ;B 244 . I $G(@ZERX@(ZI,1,1,0))["E-Rx Web" D ; 245 . . S C0QLIST(ZYR_"HasMed",DFN)="" 246 . . S C0QLIST(ZYR_"HasMedOrders",DFN)="" 247 . . S C0QLIST(ZYR_"HasERX",DFN)="" 248 . . S C0QLIST(ZYR_"HasMedRecon",DFN)="" 249 . E D ; 250 . . S C0QLIST(ZYR_"NoMed",DFN)="" 251 . . S C0QLIST(ZYR_"NoMedOrders",DFN)="" 252 . . S C0QLIST(ZYR_"NoERX",DFN)="" 253 . . S C0QLIST(ZYR_"NoMedRecon",DFN)="" 254 Q 255 ; 256 ADVDIR ; ADVANCE DIRECTIVE 257 ; 258 I $$AGE^C0QUTIL(DFN)>64 D ; ONLY FOR PATIENTS 65 AND OLDER 259 . S C0QLIST(ZYR_"Over65",DFN)="" 260 . I $$HASNTYN^C0QNOTES("ADVANCE DIRECTIVE",DFN) D ; 261 . . S C0QLIST(ZYR_"HasAdvanceDirective",DFN)="" 262 . E D ; 263 . . S C0QLIST(ZYR_"NoAdvanceDirective",DFN)="" 264 Q 265 ; 266 SMOKING ; 267 ; WANT TO CHANGE SMOKING STATUS CHECKING FOR 2012 TO A SIMPLE SET OF 268 ; HEALTH FACTORS. GPL 269 I $$INLIST(ZYR_"HasSmokingStatus",DFN) D Q ; ALREADY HAS SMOKING STAT CHECK 270 . S C0QLIST(ZYR_"HasSmokingStatus",DFN)="" 271 . S C0QLIST(ZYR_"Over12",DFN)="" 272 I $$INLIST(ZYR_"NoSmokingStatus",DFN) D Q ; ALREADY HAS SMOKING STATUS CHECK 273 . S C0QLIST(ZYR_"NoSmokingStatus",DFN)="" 274 . S C0QLIST(ZYR_"Over12",DFN)="" 275 N C0QSMOKE,C0QSYN 276 S C0QSYN=0 277 I $$AGE^C0QUTIL(DFN)<13 Q ; DON'T CHECK UNDER AGE 13 278 D HFCAT^C0QHF(.C0QSMOKE,DFN,"TOBACCO") ; GET ALL HEALTH FACTORS FOR THE 279 ; PATIENT IN THE CATEGORY OF TOBACCO 280 I $D(C0QSMOKE) S C0QSYN=1 281 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Quit Smokeless Tobacco <1 Yr Ago") 282 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Quit Smokeless Tobacco > 20 Yrs Ago") 283 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Quit Smokeless Tobacco: 1-5 Yrs Ago") 284 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Quit Smokeless Tobacco: 10-20 Yrs Ago") 285 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Quit Smokeless Tobacco: 5-10 Yrs Ago") 286 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Quit Smoking") 287 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Quit Smoking < 1 Yr Ago") 288 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Quit Smoking > 20 Yrs Ago") 289 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Quit Smoking: 1-5 Yrs Ago") 290 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Quit Smoking: 10-20 Yrs Ago") 291 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Quit Smoking: 5-10 Yrs Ago") 292 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"PREVIOUS SMOKELESS TOBACCO USER") 293 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"PREVIOUS SMOKELESS: 1-5 YRS AGO") 294 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"PREVIOUS SMOKELESS: 10-20 YRS AGO") 295 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"PREVIOUS SMOKELESS: 5-10 YRS AGO") 296 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"PREVIOUS SMOKELESS: < 1 YR AGO") 297 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"PREVIOUS SMOKELESS: > 20 YRS AGO") 298 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"PREVIOUS SMOKER") 299 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"PREVIOUS SMOKER 10-20 YRS") 300 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"PREVIOUS SMOKER 20+ YRS") 301 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"PREVIOUS SMOKER < 1 YR") 302 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"PREVIOUS SMOKER < 1 YR AGO") 303 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"PREVIOUS SMOKER > 20 YRS AGO") 304 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"PREVIOUS SMOKER: 1-5 YRS") 305 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"PREVIOUS SMOKER: 1-5 YRS AGO") 306 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"PREVIOUS SMOKER: 10-20 YRS AGO") 307 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"PREVIOUS SMOKER: 5-10 YRS") 308 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"PREVIOUS SMOKER: 5-10 YRS AGO") 309 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"PREVIOUS SMOKELESS TOBACCO USER") 310 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"LIFETIME NON-SMOKER") 311 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Former Smokeless Tobacco User") 312 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Former Smoker") 313 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Former Smoker (PMH)") 314 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoke Exposure/2nd Hand Exposure") 315 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For 1-5 Yrs") 316 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For 10-20 Yrs") 317 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For 5-10 Yrs") 318 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For < 1 Yr") 319 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For > 20 Yrs") 320 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Tobacco User") 321 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for 1-5 Yrs") 322 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for 10-20 Yrs") 323 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for 5-10 Yrs") 324 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for < 1 Yr") 325 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for > 20 Yrs") 326 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoker (HPI)") 327 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoking (FMH)") 328 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoking (PMH)") 329 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoking Cessation (OPH)") 330 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"LIFETIME NON-SMOKER") 331 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Former Smokeless Tobacco User") 332 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Former Smoker") 333 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Former Smoker (PMH)") 334 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoke Exposure/2nd Hand Exposure") 335 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For 1-5 Yrs") 336 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For 10-20 Yrs") 337 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For 5-10 Yrs") 338 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For < 1 Yr") 339 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For > 20 Yrs") 340 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Tobacco User") 341 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for 1-5 Yrs") 342 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for 10-20 Yrs") 343 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for 5-10 Yrs") 344 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for < 1 Yr") 345 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for > 20 Yrs") 346 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoker (HPI)") 347 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoking (FMH)") 348 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoking (PMH)") 349 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Non-Smoker") 350 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"LIFETIME NON-SMOKER") 351 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Former Smokeless Tobacco User") 352 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Former Smoker") 353 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Former Smoker (PMH)") 354 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoke Exposure/2nd Hand Exposure") 355 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For 1-5 Yrs") 356 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For 10-20 Yrs") 357 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For 5-10 Yrs") 358 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For < 1 Yr") 359 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For > 20 Yrs") 360 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Tobacco User") 361 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for 1-5 Yrs") 362 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for 10-20 Yrs") 363 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for 5-10 Yrs") 364 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for < 1 Yr") 365 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for > 20 Yrs") 366 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoker (HPI)") 367 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoking (FMH)") 368 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoking (PMH)") 369 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"LIFETIME NON-SMOKER") 370 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Former Smokeless Tobacco User") 371 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Former Smoker") 372 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Former Smoker (PMH)") 373 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoke Exposure/2nd Hand Exposure") 374 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For 1-5 Yrs") 375 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For 10-20 Yrs") 376 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For 5-10 Yrs") 377 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For < 1 Yr") 378 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For > 20 Yrs") 379 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Tobacco User") 380 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for 1-5 Yrs") 381 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for 10-20 Yrs") 382 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for 5-10 Yrs") 383 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for < 1 Yr") 384 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for > 20 Yrs") 385 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoker (HPI)") 386 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoking (FMH)") 387 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoking (PMH)") 388 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Non-Smoker") 389 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"LIFETIME NON-SMOKER") 390 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Former Smokeless Tobacco User") 391 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Former Smoker") 392 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Former Smoker (PMH)") 393 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoke Exposure/2nd Hand Exposure") 394 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For 1-5 Yrs") 395 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For 10-20 Yrs") 396 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For 5-10 Yrs") 397 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For < 1 Yr") 398 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For > 20 Yrs") 399 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Tobacco User") 400 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for 1-5 Yrs") 401 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for 10-20 Yrs") 402 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for 5-10 Yrs") 403 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for < 1 Yr") 404 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for > 20 Yrs") 405 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoker (HPI)") 406 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoking (FMH)") 407 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoking (PMH)") 408 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Non-Smoker") 409 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Non-Smoker (PMH)") 410 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Non-Tobacco User") 411 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Current Smoker - No") 412 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Current Smoker - Yes") 413 S C0QLIST(ZYR_"Over12",DFN)="" 414 ;N GT 415 ;S GT(1,"HasSmokingStatus","SMOK")="" 416 ;S GT(2,"HasSmokingStatus","Smok")="" 417 ;S GT(3,"HasSmokingStatus","smok")="" 418 ;I 'C0QSYN D ; 419 ;. N G 420 ;. S OK=$$TXTALL^C0QNOTES(.G,.GT,DFN) 421 ;. I $D(G) S C0QSYN=1 422 I C0QSYN S C0QLIST(ZYR_"HasSmokingStatus",DFN)="" 423 E S C0QLIST(ZYR_"NoSmokingStatus",DFN)="" 424 Q 425 ; 426 VITALS ; 427 ; 428 N C0QSDT,C0QEDT 429 D DT^DILF(,"JULY 3,2011",.C0QSDT) ; START DATE 430 D DT^DILF(,"T",.C0QEDT) ; END DATE TODAY 431 D VITALS^ORQQVI(.VITRSLT,DFN,C0QSDT,C0QEDT) ; CALL FAST VITALS 432 I $D(VITRSLT) D ;ZWR VITRSLT B ; 433 . I VITRSLT(1)["No vitals found." S C0QLIST(ZYR_"NoVitalSigns",DFN)="" 434 . E S C0QLIST(ZYR_"HasVitalSigns",DFN)="" 435 Q 436 ; 437 VTE1 ; VTE PROPHYLAXIS WITHIN 24HRS OF ARRIVAL 438 ; 439 I $$HFYN^C0QHF(DFN,"VTE PROPHYLAXIS WITHIN 24HRS OF ARRIVAL") D ; 440 . S C0QLIST(ZYR_"HasVTE24",DFN)="" 441 E S C0QLIST(ZYR_"NoVTE24",DFN)="" 442 Q 443 ; 444 COD ; TEST FOR PRELIMINARY CAUSE OF DEATH NOTE 445 I $$HASNTYN^C0QNOTES("PRELIMINARY CAUSE OF DEATH",DFN) D ; 446 . S C0QLIST(ZYR_"CauseOfDeath",DFN)="" 447 Q 448 ; 449 EDTIME ; CHECK FOR EMERGENCY DEPT TIME FACTORS 450 N FOUND 451 S FOUND=0 452 I $$HFYN^C0QHF(DFN,"ED ARRIVAL TIME") S FOUND=1 453 I '$$HFYN^C0QHF(DFN,"ED DEPARTURE TIME") S FOUND=0 454 I '$$HFYN^C0QHF(DFN,"TIME DECISION TO ADMIT MADE") S FOUND=0 455 I FOUND D ; 456 . S C0QLIST(ZYR_"HasEDtime",DFN)="" 457 E S C0QLIST(ZYR_"NoEDtime",DFN)="" 458 Q 459 ; 460 ICUPAT ; CREATE LIST OF ICU PATIENTS 461 N ZICU 462 S ZICU=$O(^SC("B","IC","")) ; IEN OF ICU HOSPITAL LOCATION 463 N ZI,ZJ,ZP 464 S ZI="" 465 F S ZI=$O(^AUPNVSIT("AHL",ZICU,ZI)) Q:ZI="" D ; EACH DATE 466 . S ZJ="" 467 . F S ZJ=$O(^AUPNVSIT("AHL",ZICU,ZI,ZJ)) Q:ZJ="" D ; EACH VISIT 468 . . S ZP=$P(^AUPNVSIT(ZJ,0),"^",5) ; DFN 469 . . S C0QLIST(ZYR_"ICUPatient",ZP)="" 470 Q 471 ; 472 FILTER ; CALLED AFTER ALL THE PATIENT LISTS HAVE BEEN FILED 473 ; WILL KILL C0QLIST AND CREATE DERIVATIVE PATIENT LISTS BY FILTERING 474 K C0QLIST 475 N ZPAT 476 S ZPAT=$$PATLN(ZYR_"Patient") ; name of patient list of all patients admitted 477 ; during the reporting period. used to filter other lists 478 ; 479 ; filter ICU patients against ZPAT 480 N GN,GO,GF 481 S GN=ZPAT 482 S GO=$$PATLN(ZYR_"ICUPatient") ; all ICU patient 483 S GF=$NA(C0QLIST(ZYR_"ICUReporting")) ; the filtered list destination 484 D AND^C0QSET(GF,GN,GO) ; filter the list with the AND set operation 485 ; 486 ; FILTER VTE-2 DENOMINATOR FOR QUALITY MEASURE 487 ; 488 S GN=$NA(C0QLIST(ZYR_"ICUReporting")) ; ICU patients admitted inside rpt period 489 S GO=$$RPATLN("MU VTE-2 DENOM PL") ; TAXONOMY BASED DENOMENATOR 490 S GF=$NA(C0QLIST(ZYR_"VTE2DEN")) ; NEW DENOMINATOR PL 491 D AND^C0QSET(GF,GN,GO) ; filter the list with the AND set operation 492 ; 493 S GN=ZPAT 494 S GO=$$RPATLN("MU VTE-3 DENOM PL") ; TAXONOMY BASED DENOMENATOR 495 S GF=$NA(C0QLIST(ZYR_"VTE3DEN")) ; NEW DENOMINATOR PL 496 D AND^C0QSET(GF,GN,GO) ; filter the list with the AND set operation 497 ; 498 S GN=ZPAT 499 S GO=$$RPATLN("MU VTE-4 DENOM PL") ; TAXONOMY BASED DENOMENATOR 500 S GF=$NA(C0QLIST(ZYR_"VTE4DEN")) ; NEW DENOMINATOR PL 501 D AND^C0QSET(GF,GN,GO) ; filter the list with the AND set operation 502 ; 503 S GN=ZPAT 504 S GO=$$RPATLN("MU VTE-5 DENOM PL") ; TAXONOMY BASED DENOMENATOR 505 S GF=$NA(C0QLIST(ZYR_"VTE5DEN")) ; NEW DENOMINATOR PL 506 D AND^C0QSET(GF,GN,GO) ; filter the list with the AND set operation 507 ; 508 D FILE ; FILE ALL THE PATIENT LISTS 509 D UPDATE^C0QUPDT(.G,5) ; UPDATE THE HOS 2011 MEANINGFUL USE measure set 510 Q 511 ; 512 ED1 ; 513 S ZYR="MU12-" 514 D DOTIME("ED DEPARTURE TIME") 515 Q 516 ; 517 ED2 ; 518 S ZYR="MU12-" 519 D DOTIME2("TIME DECISION TO ADMIT MADE") 520 Q 521 ; 522 DOTIME(ZHF) ; COMPUTE THE MEAN TIME IN THE ED FROM ARRIVAL TO DEPARTURE 523 ; THIS IS A QUALITY MEASURE ED-1 FOR MEANINGFUL USE 524 ; IT PRINTS A REPORT OF EACH PATIENT WITH THE ED TIMES RECORDED 525 ; AND THEIR TIME. AT THE END IT PRINTS THE MEAN TIME 526 N ZP 527 S ZP=$$PATLN(ZYR_"HasEDtime") ; patient list name for patients to process 528 S ZHFN=9000010.23 ; FILE NUMBER FOR V HEALTH FACTORS 529 S ZVFN=9000010 ; VISIT FILE NUMBER 530 K ZARY1,ZARY2 531 N ZI S ZI="" 532 S COUNT=0 533 F S ZI=$O(@ZP@(ZI)) Q:ZI="" D ; FOR EACH PATIENT 534 . S COUNT=COUNT+1 535 . N ZA,ZD 536 . S ZA=$$VHFIEN^C0QHF(ZI,"ED ARRIVAL TIME") ; IEN OF ARRIVAL HEALTH FACTOR 537 . S ZD=$$VHFIEN^C0QHF(ZI,ZHF) ; IEN OF DEPART HEALTH FACTOR 538 . N ZAD,ZDD ; ARRIVAL DATE, DEPARTURE DATE 539 . N ZAC,ZDC ; ARRIVAL COMMENT, DEPARTURE COMMENT 540 . ; THE COMMENT IS THE TIME XXYY 541 . N OK,TMP 542 . S TMP=$$GET1^DIQ(ZHFN,ZA_",",.03,"I") ; VISIT POINTER 543 . S ZAD=$$GET1^DIQ(ZVFN,TMP_",",.01,"I") ; VISIT DATE 544 . ;S ZAD=$P(^AUPNVHF(ZA,0),U,3) ; DATE IS PIECE 3 545 . S TMP=$$GET1^DIQ(ZHFN,ZD_",",.03,"I") ; VISIT POINTER 546 . S ZDD=$$GET1^DIQ(ZVFN,TMP_",",.01,"I") ; VISIT DATE 547 . ;S ZDD=$$GET1^DIQ(ZHFN,ZD_",",1201,"I") ; EVENT DATE FIELD 548 . ;S ZDD=$P(^AUPNVHF(ZD,0),U,3) ; DATE IS PIECE 3 549 . ;S OK=$$GET1^DIQ(ZHFN,ZA_",",81101,"","ZAC") ; ARRIVAL TIME 550 . S ZAC=$G(^AUPNVHF(ZA,811)) ; THE TIME 551 . ;S OK=$$GET1^DIQ(ZHFN,ZD_",",81101,"","ZDC") ; DEPARTURE TIME 552 . S ZDC=$G(^AUPNVHF(ZD,811)) ; DEPARTURE TIME 553 . N ZT ; THE TIME DIFFERENCE BETWEEN THE DATES 554 . W !,!,"PATIENT: ",ZI," ",$P(^DPT(ZI,0),U,1) 555 . W !,"IN: ",$$FMTE^XLFDT(ZAD_"."_ZAC)," OUT: ",$$FMTE^XLFDT(ZDD_"."_ZDC) 556 . S G1=($E(ZDC,1,2)*60)+($E(ZDC,3,4)) 557 . S G2=($E(ZAC,1,2)*60)+($E(ZAC,3,4)) 558 . I (ZDD-ZAD)>0 S G1=G1+(((ZDD-ZAD)*24)*60) 559 . S GTOT=G1-G2 560 . W !,"TIME: ",GTOT," ESTIMATED" 561 . S ZT=$$DTDIFF^C0QUTIL(ZDD,ZDC,ZAD,ZAC) ; COMPUTE THE DIFFERENCE IN MINUTES 562 . W !,"COMPUTED MINUTES: ",ZT 563 . ;I ZT'=GTOT B ; LET'S FIND OUT WHAT'S WRONG 564 . I ZT<0 D Q ; SKIP PATIENTS WITH NEGATIVE TIMES 565 . . W !,"****EXCLUDED****" 566 . I ZT>400000 D Q ; THESE ARE ERRORS 567 . . W !,"****EXCLUDED****" 568 . S ZARY1(ZT,ZI)="" ; ARRAY ORDERED BY MINUTES OF PATIENTS 569 N ZY,ZZ S ZY="" S ZZ="" 570 N ZCOUNT S ZCOUNT=0 571 F S ZY=$O(ZARY1(ZY)) Q:ZY="" D ; FOR EACH TIME 572 . F S ZZ=$O(ZARY1(ZY,ZZ)) Q:ZZ="" D ; FOR EACH PATIENT WITH THIS TIME 573 . . S ZCOUNT=ZCOUNT+1 574 . . S ZARY2(ZCOUNT,ZY,ZZ)="" 575 . . ;W !,ZCOUNT," PATIENT: ",ZZ," MINUTES: ",ZY 576 N ZMID 577 S ZMID=$P(ZCOUNT/2,".") 578 W !,"NUMBER OF PATIENTS IN REPORT: ",ZCOUNT 579 W !,"ED ARRIVAL TIME UNTIL ",ZHF 580 W !,"MEDIAN TIME: ",$O(ZARY2(ZMID,"")) 581 Q 582 ; 583 DOTIME2(ZHF) ; COMPUTE THE MEAN TIME IN THE ED FROM ARRIVAL TO DEPARTURE 584 ; THIS IS A QUALITY MEASURE ED-1 FOR MEANINGFUL USE 585 ; IT PRINTS A REPORT OF EACH PATIENT WITH THE ED TIMES RECORDED 586 ; AND THEIR TIME. AT THE END IT PRINTS THE MEAN TIME 587 N ZP 588 S ZP=$$PATLN(ZYR_"HasEDtime") ; patient list name for patients to process 589 S ZHFN=9000010.23 ; FILE NUMBER FOR V HEALTH FACTORS 590 S ZVFN=9000010 ; VISIT FILE NUMBER 591 K ZARY1,ZARY2 592 N ZI S ZI="" 593 S COUNT=0 594 F S ZI=$O(@ZP@(ZI)) Q:ZI="" D ; FOR EACH PATIENT 595 . S COUNT=COUNT+1 596 . N ZA,ZD 597 . ;S ZA=$$VHFIEN^C0QHF(ZI,"ED ARRIVAL TIME") ; IEN OF ARRIVAL HEALTH FACTOR 598 . ;S ZD=$$VHFIEN^C0QHF(ZI,ZHF) ; IEN OF DEPART HEALTH FACTOR 599 . S ZA=$$VHFIEN^C0QHF(ZI,ZHF) ; IEN OF DEPART HEALTH FACTOR 600 . S ZD=$$VHFIEN^C0QHF(ZI,"ED DEPARTURE TIME") ; IEN OF ARRIVAL HEALTH FACTOR 601 . N ZAD,ZDD ; ARRIVAL DATE, DEPARTURE DATE 602 . N ZAC,ZDC ; ARRIVAL COMMENT, DEPARTURE COMMENT 603 . ; THE COMMENT IS THE TIME XXYY 604 . N OK,TMP 605 . S TMP=$$GET1^DIQ(ZHFN,ZA_",",.03,"I") ; VISIT POINTER 606 . S ZAD=$$GET1^DIQ(ZVFN,TMP_",",.01,"I") ; VISIT DATE 607 . ;S ZAD=$P(^AUPNVHF(ZA,0),U,3) ; DATE IS PIECE 3 608 . S TMP=$$GET1^DIQ(ZHFN,ZD_",",.03,"I") ; VISIT POINTER 609 . S ZDD=$$GET1^DIQ(ZVFN,TMP_",",.01,"I") ; VISIT DATE 610 . ;S ZDD=$$GET1^DIQ(ZHFN,ZD_",",1201,"I") ; EVENT DATE FIELD 611 . ;S ZDD=$P(^AUPNVHF(ZD,0),U,3) ; DATE IS PIECE 3 612 . ;S OK=$$GET1^DIQ(ZHFN,ZA_",",81101,"","ZAC") ; ARRIVAL TIME 613 . S ZAC=$G(^AUPNVHF(ZA,811)) ; THE TIME 614 . ;S OK=$$GET1^DIQ(ZHFN,ZD_",",81101,"","ZDC") ; DEPARTURE TIME 615 . S ZDC=$G(^AUPNVHF(ZD,811)) ; DEPARTURE TIME 616 . N ZT ; THE TIME DIFFERENCE BETWEEN THE DATES 617 . W !,!,"PATIENT: ",ZI," ",$P(^DPT(ZI,0),U,1) 618 . W !,"IN: ",$$FMTE^XLFDT(ZAD_"."_ZAC)," OUT: ",$$FMTE^XLFDT(ZDD_"."_ZDC) 619 . S G1=($E(ZDC,1,2)*60)+($E(ZDC,3,4)) 620 . S G2=($E(ZAC,1,2)*60)+($E(ZAC,3,4)) 621 . I (ZDD-ZAD)>0 S G1=G1+(((ZDD-ZAD)*24)*60) 622 . S GTOT=G1-G2 623 . W !,"TIME: ",GTOT," ESTIMATED" 624 . S ZT=$$DTDIFF^C0QUTIL(ZDD,ZDC,ZAD,ZAC) ; COMPUTE THE DIFFERENCE IN MINUTES 625 . W !,"COMPUTED MINUTES: ",ZT 626 . ;I ZT'=GTOT B ; LET'S FIND OUT WHAT'S WRONG 627 . I ZT<0 D Q ; SKIP PATIENTS WITH NEGATIVE TIMES 628 . . W !,"****EXCLUDED****" 629 . I ZT>400000 D Q ; THESE ARE ERRORS 630 . . W !,"****EXCLUDED****" 631 . S ZARY1(ZT,ZI)="" ; ARRAY ORDERED BY MINUTES OF PATIENTS 632 N ZY,ZZ S ZY="" S ZZ="" 633 N ZCOUNT S ZCOUNT=0 634 F S ZY=$O(ZARY1(ZY)) Q:ZY="" D ; FOR EACH TIME 635 . F S ZZ=$O(ZARY1(ZY,ZZ)) Q:ZZ="" D ; FOR EACH PATIENT WITH THIS TIME 636 . . S ZCOUNT=ZCOUNT+1 637 . . S ZARY2(ZCOUNT,ZY,ZZ)="" 638 . . ;W !,ZCOUNT," PATIENT: ",ZZ," MINUTES: ",ZY 639 N ZMID 640 S ZMID=$P(ZCOUNT/2,".") 641 W !,"NUMBER OF PATIENTS IN REPORT: ",ZCOUNT 642 W !,"ED ARRIVAL TIME UNTIL ",ZHF 643 W !,"MEDIAN TIME: ",$O(ZARY2(ZMID,"")) 644 Q 645 ; 646 RPATLN(ZLST) ; EXTRINSIC RETURNS THE GLOBAL NAME OF THE REMINDER PATIENT LIST 647 ; WHOSE NAME IS ZLST 648 N ZIEN,ZN 649 S ZIEN=$O(^PXRMXP(810.5,"B",ZLST,"")) ; ien of patient list 650 S ZN=$NA(^PXRMXP(810.5,ZIEN,30,"B")) ; GLOBAL NAME IN REMINDER PATIENT LIST 651 Q ZN 652 ; 653 PATLN(ZATTR) ; EXTRINSIC RETURNS THE NAME OF THE PATIENT LIST WITH 654 ; THE ATTRIBUTE ZATTR 655 N ZIEN,ZN 656 S ZIEN=$O(^C0Q(301,"CATTR",ZATTR,"")) ; ien of patient list 657 S ZN=$NA(^C0Q(301,ZIEN,1,"B")) ; NAME OF PATIENT LIST IN C0Q PATIENT LIST 658 Q ZN 659 ; 660 INLIST(ZLIST,DFN) ; EXTRINSIC FOR IS PATIENT ALREADY IN LIST ZLIST 661 N ZL,ZR 662 S ZL=$O(^C0Q(301,"CATTR",ZLIST,"")) ; IEN OF LIST IN C0Q PATIENT LIST FILE 663 I ZL="" Q 0 ; LIST DOES NOT EXIST 664 S ZR=0 ; ASSUME NOT IN LIST 665 I $D(^C0Q(301,ZL,1,"B",DFN)) S ZR=1 ; PATIENT IS IN LIST 666 Q ZR 667 ; 668 ; LOOK AT GETTING RID OF PRINT AND SS AS THEY ARE NOT BEING USED. GPL 669 PRINT ; PRINT TO SCREEN 670 I $D(WARD) W !!,WARD_"-"_WARDNAME_" "_RB_": "_PTNAME_"("_PTSEX_") " 671 I $D(EXDTE) D ; 672 . W !,"Discharge Date: ",EXDTE 673 . W !,DFN," ",PTNAME 674 W !,"DOB: ",PTDOB," HRN: ",PTHRN 675 W !,"Language Spoken: ",$G(PTLANG) 676 W !,"Race: ",RACEDSC 677 W !,"Ethnicity: ",$G(ETHNDSC) 678 W !,"Problems: " 679 W !,PBDESC 680 W !,"Allergies: " 681 W !,ALDESC 682 W !,"Medications: " 683 W ! 684 Q 685 ; 686 SS ; CREATE SPREADSHEET ARRAY 687 S G1("Patient")=DFN 688 I $D(WARD) D ; 689 . S G1("WardName")=WARDNAME 690 . S G1("RoomAndBed")=RB 691 I $D(EXDTE) D ; 692 . S G1("DischargeDate")=EXDTE 693 S G1("PatientName")=PTNAME 694 S G1("Gender")=PTSEX 695 S G1("DateOfBirth")=PTDOB 696 S G1("HealthRecordNumber")=PTHRN 697 S G1("LanguageSpoken")=$G(PTLANG) 698 S G1("Race")=RACEDSC 699 S G1("Ehtnicity")=$G(ETHNDSC) 700 S G1("Problem")=PBDESC 701 I PBDESC["No problems found" S G1("HasProblem")=0 702 E S G1("HasProblem")=1 703 S G1("Allergies")=ALDESC 704 I ALDESC["No Allergy" S G1("HasAllergy")=0 705 E S G1("HasAllergy")=1 706 I $D(MDITEM) D ; 707 . S G1("HasMed")=1 708 E S G1("HasMed")=0 709 S G1("MedDescription")=$G(MDDESC) 710 I $D(MDITEM) W !,"("_MDITEM_")"_MDDESC E W !,MDDESC 711 D RNF1TO2B^C0CRNF("GRSLT","G1") 712 K G1 713 Q ; DON'T WANT TO DO THE NHIN STUFF NOW 714 ; 715 PATLIST ; CREATE PATIENT LISTS 716 ; WANT TO GET RID OF PATLIST AND MOVE FUNCTION TO OTHER ROUTINES. GPL 717 S C0QLIST(ZYR_"Patient",DFN)="" ; THE PATIENT LIST 718 N DEMOYN S DEMOYN=1 719 I $G(PTSEX)="" S DEMOYN=0 720 I $G(PTDOB)="" S DEMOYN=0 721 I $G(PTHRN)="" S DEMOYN=0 722 I $G(PTLANG)="" S DEMOYN=0 723 I $G(RACEDSC)="" S DEMOYN=0 724 I $G(ETHNDSC)="" S DEMOYN=0 725 ;I DEMOYN S C0QLIST("HasDemographics",DFN)="" 726 ;E S C0QLIST("FailedDemographics",DFN)="" 727 ;S G1("Gender")=PTSEX 728 ;S G1("DateOfBirth")=PTDOB 729 ;S G1("HealthRecordNumber")=PTHRN 730 ;S G1("LanguageSpoken")=$G(PTLANG) 731 ;S G1("Race")=RACEDSC 732 ;S G1("Ehtnicity")=$G(ETHNDSC) 733 S G1("Problem")=PBDESC 734 I PBDESC["No problems found" S C0QLIST(ZYR_"NoProblem",DFN)="" 735 E S C0QLIST(ZYR_"HasProblem",DFN)="" 736 ;S G1("Allergies")=ALDESC 737 I ALDESC["No Allergy" S C0QLIST(ZYR_"NoAllergy",DFN)="" 738 E S C0QLIST(ZYR_"HasAllergy",DFN)="" 739 ;I $D(MDITEM) D ; 740 ;. S C0QLIST("HasMed",DFN)="" 741 ;E S G1("NoMed",DFN)="" 742 ;S G1("MedDescription")=$G(MDDESC) 743 Q 744 ; 745 NHIN ; SHOW THE NHIN ARRAY FOR THIS PATIENT 746 Q:DFN=137!14 747 D EN^C0CNHIN(.G,DFN,"") 748 ZWRITE G 749 K G 750 ; 751 QUIT ;end of WARD 752 ; 753 LOCPAT(PREFIX,LOC) ;retrieve active outpatients 754 ; PREFIX WILL GO IN C0XLIST(PREFIX_"-PATIENT",DFN)="" 755 ; LOC IS HOSPITAL LOCATION 756 S ULOC=$O(^SC("B",LOC,"")) ; IEN OF HOSPITAL LOCATION 757 I ULOC="" D Q ; OOPS 758 . W !,"HOSPITAL LOCATION NOT FOUND: ",LOC 759 S IDTE=9999999-DTE ; INVERSE DATE 760 N ZI 761 S ZI="" ; BEGIN AT LATEST DATE FOR THIS LOC IN VISIT FILE 762 F S ZI=$O(^AUPNVSIT("AHL",ULOC,ZI)) Q:(ZI="")!(ZI>IDTE) D ; FOR EACH DATE 763 . W !,$$FMTE^XLFDT(9999999-ZI) ;B ; 764 . I ZI="" Q ; 765 . N ZJ S ZJ="" 766 . F S ZJ=$O(^AUPNVSIT("AHL",ULOC,ZI,ZJ)) Q:ZJ="" D ; FOR EACH VISIT 767 . . S DFN=$$GET1^DIQ(9000010,ZJ,.05,"I") ; PATIENT 768 . . S C0QLIST(PREFIX_"Patient",DFN)="" 769 Q 770 ; 771 EPPAT(ZYR) ; BUILD ALL PATIENT LISTS FOR CLINICS 772 ; 773 S DTE=3111000 774 S MUYR=ZYR 775 N ZC,ZN 776 S ZN=0 777 N ZI S ZI=0 778 F S ZI=$O(^SC(ZI)) Q:+ZI=0 D ; FOR EVERY HOSPITAL LOCATION 779 . I $$GET1^DIQ(44,ZI_",",2,"I")'="C" Q ; NOT A CLINIC 780 . S ZC=$$GET1^DIQ(44,ZI_",",.01) ; NAME OF CLINIC 781 . S ZCIEN=ZI ; IEN OF CLINIC 782 . S ZN=ZN+1 ; COUNT OF CLINICS 783 . S PRE=MUYR_"-EP-"_ZC_"-" 784 . D LOCPAT(PRE,ZC) 785 W !,"NUMBER OF CLINICS: ",ZN 786 D FILE ; CREATE ALL THE EP PATIENT LISTS 787 Q 788 ; 789 DOEP ; DO EP COMPUTATIONS 790 S ZYR="MU12-" 791 N C0QPARM,C0QCLNC 792 D INIT("C0QPARM","EP") ; INITIALIZE PARAMETERS 793 K C0QLIST ; CLEAR THE LIST 794 N ZI S ZI="" 795 F S ZI=$O(C0QPARM(ZI)) Q:ZI="" D ; FOR EACH EP 796 . S DTE=C0QPARM(ZI,"EPBeginDate") ; beginning of measurement period 797 . S EDTE=C0QPARM(ZI,"EPEndDate") ; end of measurement period -- tbd use this 798 . S C0QCLNC=C0QPARM(ZI,"CLINICS",1,1) ; only one clinic for now 799 . S PRE=ZYR_"EP-"_C0QCLNC_"-" 800 . D LOCPAT(PRE,C0QCLNC) ; GET THE PATIENTS 801 . I $D(DEBUG) ZWRITE C0QLIST 802 . M C0QLIST(ZYR_"EP-ALL-PATIENTS")=C0QLIST(PRE_"Patient") 803 S DFN="" 804 S ZYR=ZYR_"EP-" 805 F S DFN=$O(C0QLIST(ZYR_"ALL-PATIENTS",DFN)) Q:DFN="" D ; EACH PATIENT 806 . D DEMO 807 . D PROBLEM 808 . D ALLERGY 809 . ;D MEDS 810 . D ERX 811 . D SMOKING 812 . D VITALS 813 D FILE ; FILE THE PATIENT LISTS 814 N C0QCIEN 815 S ZI="" 816 F S ZI=$O(C0QPARM(ZI)) Q:ZI="" D ; 817 . S C0QCIEN=C0QPARM(ZI,"EPMeasurementSet") ; ien of measurement set 818 . D UPDATE^C0QUPDT(.G,C0QCIEN) ; UPDATE THE MU MEASUREMENT SET 819 Q 820 ; 821 DIS ; 822 N DFN,DTE,EXDTE S DTE="" 823 F D Q:DTE="" 824 . S DTE=$O(^DGPM("B",DTE)) 825 . Q:'DTE 826 . ;Q:$P(DTE,".")<3110703 827 . Q:$P(DTE,".")<3111000 ; NEW BEGIN DATE FOR FISCAL YEAR 2012 828 . S EXDTE=$$FMTE^XLFDT(DTE) 829 . N PTFM S PTFM="" 830 . D 831 . . S PTFM=$O(^DGPM("B",DTE,PTFM)) 832 . . Q:'PTFM 833 . . S DFN=$P(^DGPM(PTFM,0),U,3) 834 . . S C0QLIST(ZYR_"Patient",DFN)="" 835 . . D DEMO 836 . . D PROBLEM 837 . . D ALLERGY 838 . . D MEDS4 839 . . D RECON2 840 . . D ADVDIR 841 . . D SMOKING 842 . . D VITALS 843 . . ;D:$P(DTE,".")>3110912 VTE1 844 . . D VTE1 845 . . D COD 846 . . D EDTIME 847 . . I C0QPR D PRINT 848 . . I C0QSS D SS 849 . . I C0QPL D PATLIST 850 Q 851 ; 852 C0QPLF() Q 1130580001.301 ; FILE NUMBER FOR C0Q PATIENT LIST FILE 853 C0QALFN() Q 1130580001.311 ; FILE NUMBER FOR C0Q PATIENT LIST PATIENT SUBFILE 854 FILE ; FILE THE PATIENT LISTS TO C0Q PATIENT LIST 855 ; 856 I '$D(C0QLIST) Q ; 857 N LFN S LFN=$$C0QALFN() 858 N ZI,ZN 859 S ZI="" 860 F S ZI=$O(C0QLIST(ZI)) Q:ZI="" D ; 861 . S ZN=$O(^C0Q(301,"CATTR",ZI,"")) 862 . I ZN="" D ; LIST NOT FOUND, CREATE IT 863 . . K C0QFDA 864 . . S FN=$$C0QPLF ; C0Q PATIENT LIST FILE 865 . . S C0QFDA(FN,"+1,",.01)=ZI 866 . . S C0QFDA(FN,"+1,",999)=ZI ; ATTRIBUTE 867 . . W !,"CREATING ",ZI 868 . . D UPDIE ; ADD THE RECORD 869 . . S ZN=$O(^C0Q(301,"CATTR",ZI,"")) ; THE NEW IEN 870 . ;I ZN="" D Q ; OOPS 871 . ;. W !,"ERROR, ATTRIBUTE NOT FOUND IN PATIENT LIST FILE:"_ZI 872 . ;S ZN=$$KLNCR(ZN) ; KILL AND RECREATE RECORD ZN 873 . N C0QNEW,C0QOLD,C0QRSLT 874 . S C0QNEW=$NA(C0QLIST(ZI)) ; THE NEW PATIENT LIST 875 . S C0QOLD=$NA(^C0Q(301,ZN,1,"B")) ; THE OLD PATIENT LIST 876 . D UNITY^C0QSET("C0QRSLT",C0QNEW,C0QOLD) ; FIND WHAT'S NEW 877 . N ZJ,ZK 878 . ; FIRST, DELETE THE OLD ONES - NO LONGER IN THE LIST 879 . K C0QFDA 880 . S ZJ="" 881 . F S ZJ=$O(C0QRSLT(2,ZJ)) Q:ZJ="" D ; MARKED WITH A 2 FROM UNITY 882 . . S ZK=$O(@C0QOLD@(ZJ,"")) ; GET THE IEN OF THE RECORD TO DELETE 883 . . I ZK="" D Q ; OOPS SHOULDN'T HAPPEN 884 . . . W !,"INTERNAL ERROR FINDING A PATIENT TO DELETE" 885 . . . S $EC=",U1130580001," ; smh - instead of a BREAK 886 . . S C0QFDA(LFN,ZK_","_ZN_",",.01)="@" 887 . I $D(C0QFDA) D UPDIE ; PROCESS THE DELETIONS 888 . ; SECOND, PROCESS THE ADDITIONS 889 . K C0QFDA 890 . S ZJ="" S ZK=1 891 . F S ZJ=$O(C0QRSLT(0,ZJ)) Q:ZJ="" D ; PATIENTS TO ADD ARE MARKED WITH 0 892 . . S C0QFDA(LFN,"+"_ZK_","_ZN_",",.01)=ZJ 893 . . S ZK=ZK+1 894 . I $D(C0QFDA) D UPDIE ; PROCESS THE ADDITIONS 895 ;. Q 896 ;. K C0QFDA 897 ;. N ZJ,ZC 898 ;. S ZJ="" S ZC=1 899 ;. F S ZJ=$O(C0QLIST(ZI,ZJ)) Q:ZJ="" D ; FOR EACH PAT IN LIST 900 ;. . S C0QFDA(LFN,"?+"_ZC_","_ZN_",",.01)=ZJ 901 ;. . S ZC=ZC+1 902 ;. D UPDIE 903 ;. W !,"FOUND:"_ZI 904 Q 905 ; 906 KLNCR(ZREC) ; KILL AND RECREATE RECORD ZREC IN PATIENT LIST FILE 907 ; 908 N C0QFDA,ZFN,LIST,ATTR 909 S ZFN=$$C0QPLF() ; FILE NUMBER FOR C0Q PATIENT LIST FILE 910 D CLEAN^DILF 911 S LIST=$$GET1^DIQ(ZFN,ZREC_",",.01) ; MEASURE NAME 912 S ATTR=$$GET1^DIQ(ZFN,ZREC_",",999) ; ATTRIBUTE 913 D CLEAN^DILF 914 K ZERR 915 S C0QFDA(ZFN,ZREC_",",.01)="@" ; GET READY TO DELETE THE MEASURE 916 D FILE^DIE(,"C0QFDA","ZERR") ; KILL THE SUBFILE 917 I $D(ZERR) S ZZERR=ZZERR ; ZZERR DOESN'T EXIST, INVOKE THE ERROR TRAP IF TASKED 918 ;. W "ERROR",! 919 ;. ZWR ZERR 920 ;. B 921 K C0QFDA 922 S C0QFDA(ZFN,"+1,",.01)=LIST ; GET READY TO RECREATE THE RECORD 923 S C0QFDA(ZFN,"+1,",999)=ATTR ; ATTRIBUTE 924 D UPDIE ; CREATE THE SUBFILE 925 N ZR ; NEW IEN FOR THE RECORD 926 S ZR=$O(^C0Q(301,"CATTR",ATTR,"")) 927 ; 928 Q ZR 929 ; 930 UPDIE ; INTERNAL ROUTINE TO CALL UPDATE^DIE AND CHECK FOR ERRORS 931 K ZERR 932 D CLEAN^DILF 933 D UPDATE^DIE("","C0QFDA","","ZERR") 934 I $D(ZERR) S ZZERR=ZZERR ; ZZERR DOESN'T EXIST, INVOKE THE ERROR TRAP IF TASKED 935 ;. W "ERROR",! 936 ;. ZWR ZERR 937 ;. B 938 K C0QFDA 939 Q 940 ; 941 ; WHAT FOLLOWS IS OLD CODE - DELETE WHEN THIS WORKS 942 ;. . N PTNAME S PTNAME=$P(^DPT(DFN,0),U,1) 943 ;. . S PTDOB=$$FMTE^XLFDT($P($G(^DPT(DFN,0)),U,3)) ;date of birth 944 ;. . S PTSEX=$P($G(^DPT(DFN,0)),U,2) ;patient sex 945 ;. . D PID^VADPT ;VADPT call to grab PISD based on PT Eligibility 946 ;. . S PTHRN=$P($G(VA("PID")),U) ;health record number 947 ;. . S PTRLANG=$P($G(^DPT(DFN,256000)),U) ;ptr to language file 948 ;. . I $G(PTRLANG)'="" S PTLANG=$P(^DI(.85,PTRLANG,0),U) ;PLS extrnl 949 ;. . S RACE="" 950 ;. . F D Q:RACE="" 951 ;. . . S RACE=$O(^DPT(DFN,.02,"B",RACE)) 952 ;. . . Q:'RACE 953 ;. . . S RACEDSC=$P($G(^DIC(10,RACE,0)),U) 954 ;. . N ETHNDSC 955 ;. . N ETHNDSC S ETHNDSC="" 956 ;. . S ETHN="" 957 ;. . F D Q:ETHN="" 958 ;. . . S ETHN=$O(^DPT(DFN,.06,"B",ETHN)) 959 ;. . . Q:'ETHN 960 ;. . . S ETHNDSC=$P($G(^DIC(10.2,ETHN,0)),U) 961 ;. . D LIST^ORQQPL(.PROBL,DFN,"A") 962 ;. . S PBCNT="" 963 ;. . F S PBCNT=$O(PROBL(PBCNT)) Q:PBCNT="" D 964 ;. . . S PBDESC=$P(PROBL(PBCNT),U,2) ;problem description 965 ;. . K PROBL 966 ;. . D LIST^ORQQAL(.ALRGYL,DFN) 967 ;. . S ALCNT="" 968 ;. . F S ALCNT=$O(ALRGYL(ALCNT)) Q:ALCNT="" D 969 ;. . . S ALDESC=$P(ALRGYL(ALCNT),U,2) ;allergy description 970 ;. . K ALRGYL 971 ;. . D COVER^ORWPS(.MEDSL,DFN) 972 ;. . S MDCNT="" 973 ;. . F S MDCNT=$O(MEDSL(MDCNT)) Q:MDCNT="" D 974 ;. . . Q:$P(MEDSL(MDCNT),U,4)'="ACTIVE" ;active medications only 975 ;. . . S MDDESC=$P(MEDSL(MDCNT),U,2) ;medication description 976 ;. . . S MDITEM=$P($G(MEDSL(MDCNT)),U,3) 977 ;. . K MEDSL 978 ;. . W !,"Discharge Date: ",EXDTE 979 ;. . W !,DFN," ",PTNAME 980 ;. . W !,"DOB: ",PTDOB," HRN: ",PTHRN 981 ;. . W !,"Language Spoken: ",$G(PTLANG) 982 ;. . W !,"Race: ",RACEDSC 983 ;. . W !,"Ethnicity: ",ETHNDSC 984 ;. . W !,"Problems: " 985 ;. . W !,PBDESC 986 ;. . W !,"Allergies: " 987 ;. . W !,ALDESC 988 ;. . W !,"Medications: " 989 ;. . I $D(MDITEM) W !,"(",MDITEM,")",MDDESC E W !,MDDESC 990 ;. . W ! 991 ;Q 992 ; 993 ; 994 ; 995 ; 996 END ;end of C0QPRML; -
qrda/C0Q/trunk/p/C0QNOTES.m
r1364 r1438 1 C0QNOTES ;GPL - Utility to look up patient notes ; 9/5/11 8:50pm2 ;;1.0; MU PACKAGE;;;Build 271 C0QNOTES ;GPL - Utility to look up patient notes ; 5/23/12 5:44pm 2 ;;1.0;C0Q;;May 21, 2012;Build 43 3 3 ; 4 4 ;2011 George Lilly <glilly@glilly.net> - Licensed under the terms of the GNU … … 112 112 S GT(5,"HasMedRecon","Medication Reconcilation Complete")="" 113 113 W $$TXTALL(.G,.GT,2) ; CHECK ALL PATIENT 2'S NOTEST FOR SMOKING 114 ZWR G114 ZWRITE G 115 115 Q 116 116 ; -
qrda/C0Q/trunk/p/C0QPQRI.m
r1364 r1438 1 C0QPQRI ; GPL - GENERATES A PQRI XML FILE ; 6/14/11 17:052 ;; 0.1;C0C;nopatch;noreleasedate;Build 271 C0QPQRI ; GPL - GENERATES A PQRI XML FILE ; 5/23/12 2:42pm 2 ;;1.0;C0Q;;May 21, 2012;Build 43 3 3 ;Copyright 2011 George Lilly. Licensed under the terms of the GNU 4 4 ;General Public License See attached copy of the License. … … 100 100 ;N GGG 101 101 S GGG="//submission/measure-group ID='C'/provider/pqri-measure" ;XPATH 102 D INSINNER^C OCXPATH(ZARY,GGG,ZONE) ; INSERT XML102 D INSINNER^C0CXPATH(ZARY,GGG,ZONE) ; INSERT XML 103 103 Q 104 104 ; -
qrda/C0Q/trunk/p/C0QPRML.m
r1364 r1438 1 1 C0QPRML ;JJOH/ZAG/GPL - Patient Reminder List ;7/5/11 8:50pm 2 ;;1.0; MU PACKAGE;;;Build 272 ;;1.0;C0Q;;May 21, 2012;Build 33 3 3 ; 4 4 ;2011 Zach Gonzales<zach@linux.com> - Licensed under the terms of the GNU -
qrda/C0Q/trunk/p/C0QSET.m
r1364 r1438 1 C0QSET ;GPL - SET OPERATIONS ON LISTS ;818/11 8:50pm 2 ;;1.0; MU PACKAGE;;;Build 271 C0QSET ;GPL - SET OPERATIONS ON LISTS ;818/11 8:50pm ; 5/23/12 5:46pm 2 ;;1.0;C0Q;;May 21, 2012;Build 43 3 3 ; 4 4 ;2011 George Lilly glilly@glilly.net - Licensed under the terms of the GNU … … 29 29 S B(4)="" 30 30 D UNITY("C","A","B") 31 ZWR C31 ZWRITE C 32 32 Q 33 33 ; … … 38 38 D UNITY("DELTA",PATS,MEDS) 39 39 W !,"PATIENTS WITH NO MEDS",! 40 ZWR DELTA(0,*)40 ZWRITE DELTA(0,*) 41 41 W !,"BAD POINTERS IN THE MEDS FILE",! 42 ZWR DELTA(2,*)42 ZWRITE DELTA(2,*) 43 43 Q 44 44 ; -
qrda/C0Q/trunk/p/C0QUPDT.m
r1364 r1438 1 C0QUPDT ; GPL - Quality Reporting List Update Routines ; 8/29/11 17:052 ;; 0.1;C0Q;nopatch;noreleasedate;Build 271 C0QUPDT ; GPL - Quality Reporting List Update Routines ; 5/23/12 5:46pm 2 ;;1.0;C0Q;;May 21, 2012;Build 43 3 3 ;Copyright 2009 George Lilly. Licensed under the terms of the GNU 4 4 ;General Public License See attached copy of the License. … … 95 95 . ; FIRST PROCESS DELETIONS 96 96 . K C0QFDA ; CLEAR OUT THE FDA 97 . N ZG,ZIEN S ZG="" 97 . N ZG,ZIEN S ZG="" 98 98 . F S ZG=$O(C0QRSLT(2,ZG)) Q:ZG="" D ; FOR EACH DELETION 99 99 . . S ZIEN=$O(@C0QOLD@(ZG,"")) ; IEN OF THE ENTRY … … 104 104 . ; SECOND, PROCESS ADDITIONS 105 105 . K C0QFDA ; CLEAR OUT THE FDA 106 . N ZG,ZC S ZG="" S ZC=1 106 . N ZG,ZC S ZG="" S ZC=1 107 107 . F S ZG=$O(C0QRSLT(0,ZG)) Q:ZG="" D ; FOR EACH ADDITION 108 108 . . S C0QFDA($$C0QMMNFN(),"+"_ZC_","_ZII_","_MSET_",",.01)=ZG ; ADD THE ENTRY … … 147 147 . ; FIRST PROCESS DELETIONS 148 148 . K C0QFDA ; CLEAR OUT THE FDA 149 . N ZG,ZIEN S ZG="" 149 . N ZG,ZIEN S ZG="" 150 150 . F S ZG=$O(C0QRSLT(2,ZG)) Q:ZG="" D ; FOR EACH DELETION 151 151 . . S ZIEN=$O(@C0QOLD@(ZG,"")) ; IEN OF THE ENTRY … … 156 156 . ; SECOND, PROCESS ADDITIONS 157 157 . K C0QFDA ; CLEAR OUT THE FDA 158 . N ZG,ZC S ZG="" S ZC=1 158 . N ZG,ZC S ZG="" S ZC=1 159 159 . F S ZG=$O(C0QRSLT(0,ZG)) Q:ZG="" D ; FOR EACH ADDITION 160 160 . . S C0QFDA($$C0QMMDFN(),"+"_ZC_","_ZII_","_MSET_",",.01)=ZG ; ADD THE ENTRY … … 191 191 K ZERR 192 192 D CLEAN^DILF 193 ZWR C0QFDA193 ZWRITE C0QFDA 194 194 D UPDATE^DIE("","C0QFDA","","ZERR") 195 195 I $D(ZERR) S ZZERR=ZZERR ; ZZERR DOESN'T EXIST, INVOKE THE ERROR TRAP IF TASKED -
qrda/C0Q/trunk/p/C0QUTIL.m
r1364 r1438 1 C0QUTIL 2 ;;1.0;MU PACKAGE;;;Build 27 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 AGE(DFN) 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 DTDIFF(ZD1,ZT1,ZD2,ZT2,SHOW) 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 DT(X) 76 77 78 79 END 1 C0QUTIL ;JJOH/ZAG/GPL - Utilities for C0Q Package ;9/2/11 4:30pm 2 ;;1.0;C0Q;;May 21, 2012;Build 43 3 ; 4 ;2011 Licensed under the terms of the GNU General Public License 5 ;See attached copy of the License. 6 ; 7 ;This program is free software; you can redistribute it and/or modify 8 ;it under the terms of the GNU General Public License as published by 9 ;the Free Software Foundation; either version 2 of the License, or 10 ;(at your option) any later version. 11 ; 12 ;This program is distributed in the hope that it will be useful, 13 ;but WITHOUT ANY WARRANTY; without even the implied warranty of 14 ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15 ;GNU General Public License for more details. 16 ; 17 ;You should have received a copy of the GNU General Public License along 18 ;with this program; if not, write to the Free Software Foundation, Inc., 19 ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. 20 ; 21 AGE(DFN) ; return current age in years and months 22 ; 23 Q:'$G(DFN) ;quit if no there is no patient 24 N DOB S DOB=$P(^DPT(+DFN,0),U,3) ;date of birth 25 N YRS 26 N DOD S DOD=+$G(^DPT(9,.35)) ;check for date of death 27 I 'DOD D 28 . N CDTE S CDTE=DT ;current date 29 . S YRS=$E(CDTE,1,3)-$E(DOB,1,3)-($E(CDTE,4,7)<$E(DOB,4,7)) 30 E D 31 . S YRS=$E(DOD,1,3)-$E(DOB,1,3)-($E(DOD,4,7)<$E(DOB,4,7)) 32 ; 33 ;Come back here and fix MONTHS and DAYS 34 ;N CM S CM=+$E(DT,4,5) ;current month 35 ;N CD S CD=+$E(DT,6,7) ;current day 36 ;N BM S BM=+$E(DOB,4,5) ;birth month 37 ;N BD S BD=+$E(DOB,6,7) ;birth day 38 ; 39 ;N DAYS S DAYS="" 40 ; 41 Q YRS ;_"y" gpl ..just want the number 42 ; 43 ; 44 DTDIFF(ZD1,ZT1,ZD2,ZT2,SHOW) ; extrinsic which returns the number of minutes 45 ; between 2 dates. ZD1 and ZD2 are fileman dates 46 ; ZT1 AND ZT2 are valid times (military time) ie 20:10 47 ; IF SHOW=1 DEBUGGING INTERMEDIATE VALUES WILL BE DISPLAYED 48 I '$D(SHOW) S SHOW=0 49 N GT1,GT2,GDT1,GDT2 50 I ZT1[":" D ; 51 . S GT1=($P(ZT1,":",1)*3600)+($P(ZT1,":",2)*60) ; SECONDS 52 . S GT2=($P(ZT2,":",1)*3600)+($P(ZT2,":",2)*60) ; SECONDS 53 E D ; 54 . S GT1=($E(ZT1,1,2)*3600)+($E(ZT1,3,4)*60) 55 . S GT2=($E(ZT2,1,2)*3600)+($E(ZT2,3,4)*60) 56 ;W:SHOW !,"SECONDS: ",GT1," ",GT2 57 ;S %=GT1 D S^%DTC ; FILEMAN TIME 58 ;S GDT1=ZD1_% ; FILEMAN DATE AND TIME 59 ;S %=GT2 D S^%DTC ; FILEMAN TIME 60 ;S GDT2=ZD2_% ; FILEMAN DATE AND TIME 61 S GDT1=ZD1_"."_ZT1 62 S GDT2=ZD2_"."_ZT2 63 W:SHOW !,"FILEMAN: ",GDT1," ",GDT2 64 N ZH1,ZH2 65 S ZH1=$$FMTH^XLFDT(GDT1) ; $H FORMAT 66 S ZH2=$$FMTH^XLFDT(GDT2) ; $H FORMAT 67 W:SHOW !,"$H: ",ZH1," ",ZH2 68 N ZSECS,ZMIN 69 S ZSECS=$$HDIFF^XLFDT(ZH1,ZH2,2) ; DIFFERENCE IN $H 70 W:SHOW !,"DIFF: ",ZSECS 71 S ZMIN=ZSECS/60 ; DIFFERENCE IN MINUTES 72 W:SHOW !,"MIN: ",ZMIN 73 Q ZMIN 74 ; 75 DT(X) ; -- Returns FM date for X 76 N Y,%DT S %DT="T",Y="" D:X'="" ^%DT 77 Q Y 78 ; 79 END ;end of C0QUTIL
Note:
See TracChangeset
for help on using the changeset viewer.
