Changeset 345 for ccr/trunk/p
- Timestamp:
- Jan 29, 2009, 11:26:56 AM (16 years ago)
- Location:
- ccr/trunk/p
- Files:
-
- 3 edited
Legend:
- Unmodified
- Added
- Removed
-
ccr/trunk/p/C0CRNF.m
r344 r345 69 69 Q 70 70 ; 71 GETN(GRTN,GFILE,GREF,GNDX,GNN) ; GET BY NAME ; RETURN A FIELD VALUE MAP 72 ; THE FOLLOWING COMMENTS ARE WRONG.. THIS ROUTINE STILL RETURNS AN RNF1 73 ; FORMAT ARRAY @GRTN@("FIELD NAME")="FILE^FIELD#^VALUE" ;GPL 74 ; GETN IS AN EXTRINSIC WHICH RETURNS THE NEXT IEN AFTER THE CURRENT GIEN 75 ; GRTN, PASSED BY NAME, RETURNS A FIELD MAP AND A VALUE MAP 76 ; .. FIELD MAP @GRTN@("F","FIELDNAME^FILE^FIELD#")="" 77 ; ... ANY FIELD USED BY ANY RECORD PROCESSED IS IN THE FIELD MAP 78 ; .. VALUE MAP @GRTN@("V","IEN","FIELDNAME")=VALUE 79 ; .. GRTN IS NOT INITIALIZED, SO MULTIPLE CALLS ARE CUMULATIVE 80 ; .. IF GNN="ALL" THEN ALL FIELDS FOR THE FILE ARE IN THE FIELD MAP 81 ; .. EVEN IF GNN="ALL" ONLY POPULATED FIELDS ARE RETURNED IN THE VALUE MAP 82 ; .. NUL FIELDS CAN BE DETERMINED BY CHECKING FIELD MAP - THIS SAVES SPACE 83 ; IF GREF IS "" THE FIRST RECORD IS OBTAINED 84 ; IF GNDX IS NULL, GREF IS AN IEN FOR THE FILE 85 ; GNDX IS THE INDEX TO USE TO OBTAIN THE IEN 86 ; GREF IS THE VALUE FOR THE INDEX 87 ; GANN= NOT NULL - IF GANN IS "ALL" THEN EVEN NULL FIELDS WILL BE RETURNED 88 ; OTHERWISE, ONLY POPULATED FIELDS ARE RETURNED IN GRTN 89 ; 90 ; 91 N GIEN,GF 92 S GF=$$FILEREF(GFILE) ;CLOSED FILE REFERENCE FOR FILE NUMBER GFILE 93 I ('$D(GNDX))!(GNDX="") S GIEN=GREF ; IF NO INDEX USED, GREF IS THE IEN 94 E D ; WE ARE USING AN INDEX 95 . ;N ZG 96 . S ZG=$Q(@GF@(GNDX,GREF)) ;ACCESS INDEX 97 . I ZG'="" D ; 98 . . I $QS(ZG,3)=GREF D ; IS GREF IN INDEX? 99 . . . S GIEN=$QS(ZG,4) ; PULL OUT THE IEN 100 . . E S GIEN="" ; NOT FOUND IN INDEX 101 . E S GIEN="" ; 102 ;W "IEN: ",GIEN,! 103 ;N C0CTMP,C0CI,C0CJ,C0CREF,C0CNAME 104 I $D(GNN) I GNN="ALL" S C0CNN=0 ; NOT NON-NULL (ALL FIELDS TO BE RETURNED) 105 E S C0CNN=1 ; NON-NULL IS TRUE (ONLY POPULATED FIELDS RETURNED) 106 S C0CREF=GIEN_"," ; OPEN ROOT REFERENCE INTO FILE 107 D CLEAN^DILF ; MAKE SURE WE ARE CLEANED UP 108 K C0CTMP 109 D GETS^DIQ(GFILE,C0CREF,"**","IE","C0CTMP") 110 D FIELDS(GRTN,GFILE) ;GET ALL THE FIELD NAMES FOR THE FILE 111 S @GRTN@(0)=GFILE_"^RNF1^"_GIEN_"^"_DT_"^"_$J_"^"_DUZ ; STRUCTURE SIGNATURE 112 S (C0CI,C0CJ)="" 113 F S C0CJ=$O(C0CTMP(C0CJ)) Q:C0CJ="" D ; FOR ALL SUBFILES 114 . S C0CREF=$O(C0CTMP(C0CJ,"")) ; RECORD REFERENCE 115 . F S C0CI=$O(C0CTMP(C0CJ,C0CREF,C0CI)) Q:C0CI="" D ; ARRAY OF FIELDS 116 . . ;W C0CJ," ",C0CI,! 117 . . S C0CNAME=$P(^DD(C0CJ,C0CI,0),"^",1) ;PULL THE FIELD NAME 118 . . S C0CVALUE=C0CTMP(C0CJ,C0CREF,C0CI,"E") ; 119 . . I C0CVALUE["C0CTMP" D ; WP FIELD 120 . . . N ZT,ZWP S ZWP=0 ;ITERATOR 121 . . . S ZWP=$O(C0CTMP(C0CJ,C0CREF,C0CI,ZWP)) ; INIT TO FIRST LINE 122 . . . S C0CVALUE=C0CTMP(C0CJ,C0CREF,C0CI,ZWP) ; INIT TO FIRST LINE 123 . . . F S ZWP=$O(C0CTMP(C0CJ,C0CREF,C0CI,ZWP)) Q:'ZWP D ; 124 . . . . S ZT=" "_C0CTMP(C0CJ,C0CREF,C0CI,ZWP) ;LINE OF WP 125 . . . . S ZT=$TR(ZT,"^""","|'") ;HACK TO GET RID OF ^ AND " IN TEXT " 126 . . . . S C0CVALUE=C0CVALUE_ZT ; 127 . . S $P(@GRTN@(C0CNAME),"^",3)=C0CVALUE ;RETURN VALUE IN P3 128 . . S $P(@GRTN@(C0CNAME,"I"),"^",3)=$G(C0CTMP(C0CJ,C0CREF,C0CI,"I")) 129 I C0CNN D ; IF ONLY NON-NULL VALUES ARE TO BE RETURNED 130 . S C0CI="" 131 . F S C0CI=$O(@GRTN@(C0CI)) Q:C0CI="" D ; GO THROUGH THE WHOLE ARRAY 132 . . I $P(@GRTN@(C0CI),"^",3)="" K @GRTN@(C0CI) ; KILL THE NULL ENTRIES 133 Q 134 ; 71 135 GETN1(GRTN,GFILE,GREF,GNDX,GNN) ; NEW GET ;GPL ; RETURN A FIELD VALUE MAP 72 136 ; THE FOLLOWING COMMENTS ARE WRONG.. THIS ROUTINE STILL RETURNS AN RNF1 … … 95 159 . ;N ZG 96 160 . S ZG=$Q(@GF@(GNDX,GREF)) ;ACCESS INDEX 97 . I $QS(ZG,3)=GREF D ; IS GREF IN INDEX? 98 . . S GIEN=$QS(ZG,4) ; PULL OUT THE IEN 99 . E S GIEN="" ; NOT FOUND IN INDEX 100 W "IEN: ",GIEN,! 161 . I ZG'="" D ; 162 . . I $QS(ZG,3)=GREF D ; IS GREF IN INDEX? 163 . . . S GIEN=$QS(ZG,4) ; PULL OUT THE IEN 164 . . E S GIEN="" ; NOT FOUND IN INDEX 165 . E S GIEN="" ; 166 ;W "IEN: ",GIEN,! 101 167 ;N C0CTMP,C0CI,C0CJ,C0CREF,C0CNAME 102 168 I $D(GNN) I GNN="ALL" S C0CNN=0 ; NOT NON-NULL (ALL FIELDS TO BE RETURNED) -
ccr/trunk/p/C0CRPMS.m
r342 r345 23 23 DISPLAY ; RUN THE PCC DISPLAY ROUTINE 24 24 D ^APCDDISP 25 Q 26 ; 27 VTYPES ; 28 D GETN2^C0CRNF("G1",9999999.07) 29 ZWR G1 25 30 Q 26 31 ; … … 91 96 Q 92 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 ; -
ccr/trunk/p/GPLALERT.m
r343 r345 70 70 . E S @ALTVMAP@("ALERTSOURCEID")="" ; SOURCE NULL - SHOULD NOT HAPPEN 71 71 . W "RUNNING ALERTS, PROVIDER: ",@ALTVMAP@("ALERTSOURCEID"),! 72 . N ACGL1,ACGFI,ACIEN,ACVUID 72 . N ACGL1,ACGFI,ACIEN,ACVUID,ACNM,ACTMP 73 73 . S ACGL1=$P(@ALTG@(ALTTMP),U,9) ; ADDRESS OF THE REACTANT XX;GLB(YY.Z, 74 74 . S ACGFI=$$PRSGLB($P(ACGL1,";",2)) ; FILE NUMBER … … 77 77 . S @ALTVMAP@("ALERTAGENTPRODUCTOBJECTID")="PRODUCT_"_ACIEN ; IE OF REACTANT 78 78 . S @ALTVMAP@("ALERTAGENTPRODUCTSOURCEID")="" ; WHERE DO WE GET THIS? 79 . S @ALTVMAP@("ALERTAGENTPRODUCTNAMETEXT")=$P(@ALTG@(ALTTMP),U,2) ; REACTANT 79 . S ACNM=$P(@ALTG@(ALTTMP),U,2) ; REACTANT 80 . S @ALTVMAP@("ALERTAGENTPRODUCTNAMETEXT")=ACNM 80 81 . S @ALTVMAP@("ALERTAGENTPRODUCTCODEVALUE")=ACVUID 81 82 . I ACVUID'="" D ; IF VUID IS NOT NULL 82 83 . . S @ALTVMAP@("ALERTAGENTPRODUCTCODESYSTEM")="VUID" 83 84 . E D ; IF REACTANT CODE VALUE IS NULL 85 . . I $G(DUZ("AG"))="I" D ; IF WE ARE RUNNING ON RPMS 86 . . . S ACTMP=$O(^C0CCODES(176.112,"C",ACNM,0)) ; 87 . . . W "RPMS NAME FOUND",ACNM," ",ACTMP,! 84 88 . . S @ALTVMAP@("ALERTAGENTPRODUCTCODESYSTEM")="" 85 89 . . S @ALTVMAP@("ALERTAGENTPRODUCTCODEVALUE")=""
Note:
See TracChangeset
for help on using the changeset viewer.