Changeset 1332 for ccr/branches/ohum/p/C0CRPMS.m
- Timestamp:
- Jan 4, 2012, 12:05:03 AM (12 years ago)
- File:
-
- 1 edited
-
ccr/branches/ohum/p/C0CRPMS.m (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
ccr/branches/ohum/p/C0CRPMS.m
r1330 r1332 1 C0CRPMS 2 ;;0.1;CCDCCR;;JUL 16,2008;Build 1 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 DISPLAY 24 25 26 27 VTYPES 28 29 30 31 32 VISITS(C0CDFN,C0CCNT) 33 34 35 36 37 38 39 40 41 42 VISITS2(C0CDFN,C0CCNT) 43 44 45 46 47 48 49 50 51 52 53 NEXTV(C0CDFN,C0CVDT) 54 55 56 57 58 59 60 61 62 63 GETV(C0CDFN,C0CVDT) 64 65 66 67 68 69 70 71 72 73 74 GETNV(C0CDFN) 75 76 77 78 79 80 81 82 83 84 85 86 GETTBL(C0CTBL) 87 88 89 90 91 92 93 94 95 96 97 98 CMPDRG 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 CMPDRG2 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 1 C0CRPMS ; CCDCCR/GPL - CCR/CCD PROCESSING FOR RPMS ;1/14/09 14:33 2 ;;0.1;CCDCCR;;JUL 16,2008;Build 7 3 ;Copyright 2008 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 W "NO ENTRY FROM TOP",! 21 Q 22 ; 23 DISPLAY ; RUN THE PCC DISPLAY ROUTINE 24 D ^APCDDISP 25 Q 26 ; 27 VTYPES ; 28 D GETN2^C0CRNF("G1",9999999.07) 29 ZWR G1 30 Q 31 ; 32 VISITS(C0CDFN,C0CCNT) ;LIST VISIT DATES FOR PATIENT DFN 33 ; C0CCNT IS A LIMIT ON HOW MANY VISITS TO DISPLAY ; DEFAULTS TO ALL 34 I '$D(C0CCNT) S C0CCNT=999999999 35 N G,GN 36 S G="" S GN=0 37 F S G=$O(^AUPNVSIT("AA",C0CDFN,G)) Q:(G="")!(GN>C0CCNT) D ; 38 . S GN=GN+1 39 . W $$FMDTOUTC^C0CUTIL(9999999-G),! 40 Q 41 ; 42 VISITS2(C0CDFN,C0CCNT) ;SECOND VERSION USING NEXTV 43 ; 44 N C0CG,GN 45 S C0CG="" 46 S GN=0 47 I '$D(C0CCNT) S C0CCNT=99999999 48 F S C0CG=$$NEXTV(C0CDFN,C0CG) Q:(C0CG="")!(GN'<C0CCNT) D ; 49 . S GN=GN+1 50 . W $$FMDTOUTC^C0CUTIL(C0CG),! 51 Q 52 ; 53 NEXTV(C0CDFN,C0CVDT) ;EXTRINSIC WHICH RETURNS THE NEXT VISIT DATE 54 ;FOR PATIENT C0CDFN IN REVERSE TIME ORDER; PASS "" TO GET THE MOST 55 ; RECENT VISIT 56 N G 57 S G=C0CVDT 58 I G'="" S G=9999999-C0CVDT ;INVERT FOR INDEX 59 S G=$O(^AUPNVSIT("AA",C0CDFN,G)) 60 I G="" Q "" 61 E Q 9999999-G 62 ; 63 GETV(C0CDFN,C0CVDT) ; GET VISIT USING DATE C0CVDT . IF C0CVDT IS NULL, 64 ; GET MOST RECENT VISIT 65 N C0CG 66 I '$D(C0CVDT) S C0CVDT=$$NEXTV(C0CDFN,"") 67 S APCDVLDT=C0CVDT 68 S APCDPAT=C0CDFN 69 D ^APCDVLK 70 D ^APCDVD 71 ;K APCDCLN,APCDCAT,APCDDATE,APCDLOC,APCDVSIT,APCDLOOK,APCDTYPE 72 Q 73 ; 74 GETNV(C0CDFN) ;GET MANY VISITS 75 ; 76 S APCDPAT=C0CDFN ; 77 N C0CG S C0CG="" 78 F S C0CG=$$NEXTV(C0CDFN,C0CG) Q:C0CG="" D ; LOOP BACKWARD THROUGH VISITS 79 . W C0CG," ",$$FMDTOUTC^C0CUTIL(C0CG),! 80 . S APCDVLDT=C0CG 81 . D ^APCDVLK 82 . D ^APCDVD 83 . K APCDCLN,APCDCAT,APCDDATE,APCDLOC,APCDVSIT,APCDLOOK,APCDTYPE 84 Q 85 ; 86 GETTBL(C0CTBL) ; SCAN FOR AND DISPLAY PATIENTS IN A RIMTBL, PASSED BY VALUE 87 ; 88 N ZG S ZG=$NA(^TMP("GPLRIM","RIMTBL","PATS",C0CTBL)) 89 N C0CG S C0CG="" 90 N C0CQ S C0CQ=0 91 F S C0CG=$O(@ZG@(C0CG),-1) Q:(C0CG="") D ; 92 . W "PAT: ",C0CG,! 93 . D GETNV^C0CRPMS(C0CG) 94 . K X R X 95 . I X="Q" S C0CQ=1 ; QUIT IF Q 96 Q 97 ; 98 CMPDRG ; COMPARE THE DRUG FILE TO THE VA VUID MAPPING FILE FOR MATCHES 99 ; 100 S C0CZI=0 ; 101 F S C0CZI=$O(^C0CDRUG("V",C0CZI)) Q:C0CZI="" D ;ALL DRUGS IN RPMS DRUG FILE 102 . S C0CZJ="" ; FOR EVERY FIELD AND SUBFIELD IN THE DRUG FILE 103 . ;W "C0CZI:",C0CZI 104 . F S C0CZJ=$O(^C0CDRUG("V",C0CZI,C0CZJ)) Q:C0CZJ="" D ; 105 . . ;W " C0CZJ:",C0CZJ 106 . . N C0CZN,C0CZV ; 107 . . S C0CZN=^C0CDRUG("V",C0CZI,C0CZJ,1) ; EVERY FIELD VALUE 108 . . ;W " C0CZN:",C0CZN,! 109 . . D GETN1^C0CRNF("C0CZV",176.112,C0CZN,"C") ;LOOK IN C XREF 110 . . I $D(C0CZV) D ;FOUND A MATCH 111 . . . S C0CVO="FOUND:^"_C0CZI_"^"_C0CZJ_"^"_C0CZN 112 . . . S C0CVO=C0CVO_"^RXNORM:^"_$$ZVALUE^C0CRNF("MEDIATION CODE","C0CZV") 113 . . . D PUSH^GPLXPATH("^C0CZRX",C0CVO) 114 . . . W C0CVO,! 115 Q 116 ; 117 CMPDRG2 ; COMPARE THE DRUG FILE TO THE VA VUID MAPPING FILE FOR MATCHES 118 ; 119 S C0CZI=0 ; 120 F S C0CZI=$O(^C0CDRUG("V",C0CZI)) Q:C0CZI="" D ;ALL DRUGS IN RPMS DRUG FILE 121 . S C0CZJ="" ; FOR EVERY FIELD AND SUBFIELD IN THE DRUG FILE 122 . W "C0CZI:",C0CZI 123 . F S C0CZJ=$O(^C0CDRUG("V",C0CZI,C0CZJ)) Q:C0CZJ="" D ; 124 . . W " C0CZJ:",C0CZJ 125 . . N C0CZN,C0CZV ; 126 . . S C0CZN=^C0CDRUG("V",C0CZI,C0CZJ,1) ; EVERY FIELD VALUE 127 . . W " C0CZN:",C0CZN,! 128 . . D GETN1^C0CRNF("C0CZV",176.112,C0CZN,"C") ;LOOK IN C XREF 129 . . I $D(C0CZV) D ;FOUND A MATCH 130 . . . W "FOUND: ",C0CZI," ",C0CZJ," ",C0CZN 131 . . . W " VUID:",$$ZVALUE^C0CRNF("VUID","C0CZV"),! 132 Q 133 ;
Note:
See TracChangeset
for help on using the changeset viewer.
