Changeset 1336 for ccr/trunk/p/C0CFM1.m
- Timestamp:
- Jan 4, 2012, 9:39:08 PM (12 years ago)
- File:
-
- 1 edited
-
ccr/trunk/p/C0CFM1.m (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
ccr/trunk/p/C0CFM1.m
r1331 r1336 1 C0CFM1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 PUTRIM(DFN,ZWHICH) 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 PUTRIM1(DFN,ZZTYP,ZVARS) 40 41 42 43 44 45 46 47 48 PUTELS(DFN,ZTYPE,ZOCC,ZVALS) 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 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 VARPTR(ZVAR,ZTYP) 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 BLDTYPS 118 119 120 121 122 123 124 125 FIXSEC 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 SETFDA(C0CSN,C0CSV) 143 144 145 146 147 148 149 150 151 152 ZFILE(ZFN,ZTAB) 153 154 155 156 157 158 159 160 ZFIELD(ZFN,ZTAB) 161 162 163 164 165 166 167 168 169 ZVALUE(ZFN,ZTAB) 170 171 172 173 174 175 176 177 1 C0CFM1 ; CCDCCR/GPL - CCR FILEMAN utilities; 12/6/08 2 ;;1.0;C0C;;May 19, 2009;Build 38 3 ;Copyright 2009 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 "This is the CCR FILEMAN Utility Library ",! 21 W ! 22 Q 23 ; 24 PUTRIM(DFN,ZWHICH) ;DFN IS PATIENT , WHICH IS ELEMENT TYPE 25 ; 26 S C0CGLB=$NA(^TMP("GPLRIM","VARS",DFN)) 27 I '$D(ZWHICH) S ZWHICH="ALL" 28 I ZWHICH'="ALL" D ; SINGLE SECTION REQUESTED 29 . S C0CVARS=$NA(@C0CGLB@(ZWHICH)) 30 . D PUTRIM1(DFN,ZWHICH,C0CVARS) ; IF ONE SECTION 31 E D ; MULTIPLE SECTIONS 32 . S C0CVARS=$NA(@C0CGLB) 33 . S C0CI="" 34 . F S C0CI=$O(@C0CVARS@(C0CI)) Q:C0CI="" D ;FOR EACH SECTION 35 . . S C0CVARSN=$NA(@C0CVARS@(C0CI)) ; GRAB ONE SECTION 36 . . D PUTRIM1(DFN,C0CI,C0CVARSN) 37 Q 38 ; 39 PUTRIM1(DFN,ZZTYP,ZVARS) ; PUT ONE SECTION OF VARIABLES INTO CCR ELEMENTS 40 ; ZVARS IS PASSED BY NAME AN HAS THE FORM @ZVARS@(1,"VAR1")="VAL1" 41 S C0CX=0 42 F S C0CX=$O(@ZVARS@(C0CX)) Q:C0CX="" D ; FOR EACH OCCURANCE 43 . W "ZOCC=",C0CX,! 44 . S C0CV=$NA(@ZVARS@(C0CX)) ; VARIABLES FOR THIS OCCURANCE 45 . D PUTELS(DFN,ZZTYP,C0CX,C0CV) ; PUT THEM TO THE CCR ELEMENTS FILE 46 Q 47 ; 48 PUTELS(DFN,ZTYPE,ZOCC,ZVALS) ; PUT CCR VALUES INTO THE CCR ELEMENTS FILE 49 ; ^C0C(171.201, DFN IS THE PATIENT IEN PASSED BY VALUE 50 ; ZTYPE IS THE NODE TYPE IE RESULTS,PROBLEMS PASSED BY VALUE 51 ; ZOCC IS THE OCCURANCE NUMBER IE PROBLEM NUMBER 1,2,3 ETC 52 ; ZVALS ARE THE VARIABLES AND VALUES PASSED BY NAME AND IN THE FORM 53 ; @ZVALS@("VAR1")="VALUE1" FOR ALL VARIABLES IN THIS ELEMENT 54 ; AND @ZVALS@("M",SUBOCCUR,"VAR2")="VALUE2" FOR SUB VARIABLES 55 ; 56 S ZSRC=1 ; CCR SOURCE IS ASSUMED TO BE THIS EHR, WHICH IS ALWAYS SOURCE 1 57 ; PUT THIS IN PARAMETERS - SO SOURCE NUMBER FOR PROCESSING IN CONFIGURABLE 58 N ZF,ZFV S ZF=171.201 S ZFV=171.2012 59 S ZSUBF=171.20122 ;FILE AND SUBFILE NUMBERS 60 N ZSFV S ZSFV=171.201221 ; SUBFILE VARIABLE FILE NUMBER 61 N ZTYPN S ZTYPN=$O(^C0CDIC(170.101,"B",ZTYPE,"")) 62 W "ZTYPE: ",ZTYPE," ",ZTYPN,! 63 N ZVARN ; IEN OF VARIABLE BEING PROCESSED 64 ;N C0CFDA ; FDA FOR CCR ELEMENT UPDATE 65 S C0CFDA(ZF,"?+1,",.01)=DFN 66 S C0CFDA(ZF,"?+1,",.02)=ZSRC 67 S C0CFDA(ZF,"?+1,",.03)=ZTYPN 68 S C0CFDA(ZF,"?+1,",.04)=ZOCC ;CREATE OCCURANCE 69 K ZERR 70 D UPDATE^DIE("","C0CFDA","","ZERR") ;ASSIGN RECORD NUMBER 71 I $D(ZERR) B ;OOPS 72 K C0CFDA 73 S ZD0=$O(^C0C(ZF,"C",DFN,ZSRC,ZTYPN,ZOCC,"")) 74 W "RECORD NUMBER: ",ZD0,! 75 ;B 76 S ZCNT=0 77 S ZC0CI="" ; 78 F S ZC0CI=$O(@ZVALS@(ZC0CI)) Q:ZC0CI="" D ; 79 . I ZC0CI'="M" D ; NOT A SUBVARIABLE 80 . . S ZCNT=ZCNT+1 ;INCREMENT COUNT 81 . . S ZVARN=$$VARPTR(ZC0CI,ZTYPE) ;GET THE POINTER TO THE VAR IN THE CCR DICT 82 . . ; WILL ALLOW FOR LAYGO IF THE VARIABLE IS NOT FOUND 83 . . S C0CFDA(ZFV,"?+"_ZCNT_","_ZD0_",",.01)=ZVARN 84 . . S C0CFDA(ZFV,"?+"_ZCNT_","_ZD0_",",1)=@ZVALS@(ZC0CI) 85 . . ;S C0CFDA(ZSFV,"+1,"_DFN_","_ZSRC_","_ZTYPN_","_ZOCC_",",.01)=ZVARN 86 . . ;S C0CFDA(ZSFV,"+1,"_DFN_","_ZSRC_","_ZTYPN_","_ZOCC_",",1)=@ZVALS@(ZC0CI) 87 ;S GT1(170,"?+1,",.01)="ZZZ NEW MEDVEHICLETEXT" 88 ;S GT1(170,"?+1,",12)="DIR" 89 ;S GT1(171.201221,"?+1,1,5,1,",.01)="ZZZ NEW MEDVEHICLETEXT" 90 ;S GT1(171.201221,"+1,1,5,1,",1)="THIRD NEW MED DIRECTION TEXT" 91 D CLEAN^DILF 92 D UPDATE^DIE("","C0CFDA","","ZERR") 93 Q 94 ; 95 VARPTR(ZVAR,ZTYP) ;EXTRINSIC WHICH RETURNS THE POINTER TO ZVAR IN THE 96 ; CCR DICTIONARY. IT IS LAYGO, AS IT WILL ADD THE VARIABLE TO 97 ; THE CCR DICTIONARY IF IT IS NOT THERE. ZTYP IS REQUIRED FOR LAYGO 98 ; 99 N ZCCRD,ZVARN,C0CFDA2 100 S ZCCRD=170 ; FILE NUMBER FOR CCR DICTIONARY 101 S ZVARN=$O(^C0CDIC(170,"B",ZVAR,"")) ;FIND IEN OF VARIABLE 102 I ZVARN="" D ; VARIABLE NOT IN CCR DICTIONARY - ADD IT 103 . I '$D(ZTYP) D Q ; WON'T ADD A VARIABLE WITHOUT A TYPE 104 . . W "CANNOT ADD VARIABLE WITHOUT A TYPE: ",ZVAR,! 105 . S C0CFDA2(ZCCRD,"?+1,",.01)=ZVAR ; NAME OF NEW VARIABLE 106 . S C0CFDA2(ZCCRD,"?+1,",12)=ZTYP ; TYPE EXTERNAL OF NEW VARIABLE 107 . D CLEAN^DILF ;MAKE SURE ERRORS ARE CLEAN 108 . D UPDATE^DIE("E","C0CFDA2","","ZERR") ;ADD VAR TO CCR DICTIONARY 109 . I $D(ZERR) D ; LAYGO ERROR 110 . . W "ERROR ADDING "_ZC0CI_" TO CCR DICTIONARY",! 111 . E D ; 112 . . D CLEAN^DILF ; CLEAN UP 113 . . S ZVARN=$O(^C0CDIC(170,"B",ZVAR,"")) ;FIND IEN OF VARIABLE 114 . . W "ADDED ",ZVAR," TO CCR DICTIONARY, IEN:",ZVARN,! 115 Q ZVARN 116 ; 117 BLDTYPS ; ROUTINE TO POPULATE THE CCR NODE TYPES FILE (^C0CDIC(170.101,) 118 ; THE CCR DICTIONARY (^C0CDIC(170, ) HAS MOST OF WHAT'S NEEDED 119 ; 120 N C0CDIC,C0CNODE ; 121 S C0CDIC=$$FILEREF^C0CRNF(170) ; CLOSED FILE REFERENCE TO THE CCR DICTIONARY 122 S C0CNODE=$$FILEREF^C0CRNF(170.101) ; CLOSED REF TO CCR NODE TYPE FILE 123 Q 124 ; 125 FIXSEC ;FIX THE SECTION FIELD OF THE CCR DICTIONARY.. IT HAS BEEN REDEFINED 126 ; AS A POINTER TO CCR NODE TYPE INSTEAD OF BEING A SET 127 ; THE SET VALUES ARE PRESERVED IN ^KBAI("SECTION") TO FACILITATE THIS 128 ; CONVERSION 129 ;N C0CC,C0CI,C0CJ,C0CN,C0CZX 130 D FIELDS^C0CRNF("C0CC",170) 131 S C0CI="" 132 F S C0CI=$O(^KBAI("SECTION",C0CI)) Q:C0CI="" D ; EACH SECTION 133 . S C0CZX="" 134 . F S C0CZX=$O(^KBAI("SECTION",C0CI,C0CZX)) Q:C0CZX="" D ; EACH VARIABLE 135 . . W "SECTION ",C0CI," VAR ",C0CZX 136 . . S C0CV=$O(^C0CDIC(170.101,"B",C0CI,"")) 137 . . W " TYPE: ",C0CV,! 138 . . D SETFDA("SECTION",C0CV) 139 . . ;ZWR C0CFDA 140 Q 141 ; 142 SETFDA(C0CSN,C0CSV) ; INTERNAL ROUTINE TO MAKE AN FDA ENTRY FOR FIELD C0CSN 143 ; TO SET TO VALUE C0CSV. 144 ; C0CFDA,C0CC,C0CZX ARE ASSUMED FROM THE CALLING ROUTINE 145 ; C0CSN,C0CSV ARE PASSED BY VALUE 146 ; 147 N C0CSI,C0CSJ 148 S C0CSI=$$ZFILE(C0CSN,"C0CC") ; FILE NUMBER 149 S C0CSJ=$$ZFIELD(C0CSN,"C0CC") ; FIELD NUMBER 150 S C0CFDA(C0CSI,C0CZX_",",C0CSJ)=C0CSV 151 Q 152 ZFILE(ZFN,ZTAB) ; EXTRINSIC TO RETURN FILE NUMBER FOR FIELD NAME PASSED 153 ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 1 OF C0CA(ZFN) 154 ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA 155 I '$D(ZTAB) S ZTAB="C0CA" 156 N ZR 157 I $D(@ZTAB@(ZFN)) S ZR=$P(@ZTAB@(ZFN),"^",1) 158 E S ZR="" 159 Q ZR 160 ZFIELD(ZFN,ZTAB) ;EXTRINSIC TO RETURN FIELD NUMBER FOR FIELD NAME PASSED 161 ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 2 OF C0CA(ZFN) 162 ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA 163 I '$D(ZTAB) S ZTAB="C0CA" 164 N ZR 165 I $D(@ZTAB@(ZFN)) S ZR=$P(@ZTAB@(ZFN),"^",2) 166 E S ZR="" 167 Q ZR 168 ; 169 ZVALUE(ZFN,ZTAB) ;EXTRINSIC TO RETURN VALUE FOR FIELD NAME PASSED 170 ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 3 OF C0CA(ZFN) 171 ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA 172 I '$D(ZTAB) S ZTAB="C0CA" 173 N ZR 174 I $D(@ZTAB@(ZFN)) S ZR=$P(@ZTAB@(ZFN),"^",3) 175 E S ZR="" 176 Q ZR 177 ;
Note:
See TracChangeset
for help on using the changeset viewer.
