Changeset 126 for ccr/trunk/p
- Timestamp:
- Sep 1, 2008, 10:45:59 AM (16 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
ccr/trunk/p/GPLMEDS.m
r122 r126 37 37 S MEDTARYTMP=$NA(^TMP("GPLCCR",$J,"MEDARYTMP")) 38 38 K @MEDTVMAP,@MEDTARYTMP 39 N DONE S DONE=0 40 F J=1:3 Q:'$D(MEDRSLT(J))!DONE D ; FOR EACH MEDICATION IN THE LIST 41 . I DEBUG W "J IS ",J,! 42 . S MEDVMAP=$NA(@MEDTVMAP@(J)) 39 ; FIRST GO THROUGH MEDRSLT ARRAY AND COUNT MEDS AND LINES IN MEDS 40 ; ZA(0) IS TOTAL NUMBER OF MEDS ZA(ZI) IS LINES IN MED ZI 41 N ZA,ZI,ZJ,ZK,ZN S (ZI,ZJ,ZK,ZN)=0 ; ZI IS MED NUMBER, ZJ IS LINE IN MED 42 ; ZK IS THE NUMBER OF LINES IN A MED AND ZN IS COUNTER THROUGH LINES 43 S ZA(0)=0 ; ZA IS ARRAY OF MED LINE COUNTS 44 F ZJ=1:1 Q:'$D(MEDRSLT(ZJ)) D ; COUNT THE MEDS AND LINES 45 . I MEDRSLT(ZJ)?1"~".E D ; FOUND NEW MED 46 . . S ZI=ZI+1 ; INCREMENT MED COUNT 47 . . S ZA(0)=ZI ; NEW TOTAL FOR MEDS 48 . . S ZA(ZI)=ZJ_U_1 ; EACH ZA(X) IS Y^Z WHERE Y IS START LINE AND Z IS COUNT 49 . E D ; FOR EVERY LINE NOT A FIRST LINE IN MED 50 . . S ZK=$P(ZA(ZI),U,2)+1 ; INCREMENT LINE COUNT FOR CURRENT MED 51 . . S $P(ZA(ZI),U,2)=ZK ; AND STORE IT IN ARRAY 52 ZWR ZA 53 F ZI=1:1:ZA(0) D ; FOR EACH MED 54 . I DEBUG W "ZI IS ",ZI,! 55 . S MEDVMAP=$NA(@MEDTVMAP@(ZI)) 43 56 . K @MEDVMAP 44 57 . I DEBUG W "VMAP= ",MEDVMAP,! 45 . S MEDPTMP=MEDRSLT(J) ; PULL OUT MEDICATION FROM RPC RETURN ARRAY46 . S @MEDVMAP@("MEDOBJECTID")="MED"_J ; UNIQUE OBJID FOR MEDS47 . ; PROCESSING FOR MEDS GOES HERE58 . S ZJ=$P(ZA(ZI),U,1) ; INDEX OF FIRST LINE OF MED IN MEDRSLT 59 . S MEDPTMP=MEDRSLT(ZJ) ; PULL OUT FIRST LINE OF MED 60 . S @MEDVMAP@("MEDOBJECTID")="MED"_ZI ; UNIQUE OBJID FOR MEDS 48 61 . S @MEDVMAP@("MEDISSUEDATETXT")=$$FMDTOUTC^CCRUTIL($P(MEDPTMP,"^",11),"DT") ; GETS LAST FILL DATE 49 62 . S @MEDVMAP@("MEDDATETIMEAGE")="" … … 66 79 . S @MEDVMAP@("MEDQUANTITYUNIT")="" 67 80 . S @MEDVMAP@("MEDRFNO")="" 68 . I $D(MEDRSLT(J+1)) D ; IF SECOND LINE EXISTS 69 . . S @MEDVMAP@("MEDDESCRIPTIONTEXT")=$P(MEDRSLT(J+1)," *",2) 70 . I $D(MEDRSLT(J+2)) D ; IF THIRD LINE EXISTS 71 . . S @MEDVMAP@("MEDDIRECTIONDESCRIPTIONTEXT")=$P(MEDRSLT(J+2),"\ Sig: ",2) 72 . I $D(MEDRSLT(J+3)) D ; IF THERE IS ANOTHER LINE 73 . . I MEDRSLT(J+3)?1"t".E D ; CONTINUATION LINES 74 . . . I $D(MEDRSLT(J+6)) D ; 75 . . . . S J=J=3 ; SKIP THREE LINES TO NEXT MED 76 . . . E S DONE=1 ; ELSE NO MORE MEDS 81 . S ZK=$P(ZA(ZI),U,2) ; NUMBER OF LINES IN MED 82 . I ZK>1 D ; MORE THAN ONE LINE IN MED 83 . . S @MEDVMAP@("MEDDESCRIPTIONTEXT")=$P(MEDRSLT(ZJ+1)," *",2) 84 . I ZK>2 D ; THIRD THROUGH 2+N LINES OF MED ARE INSTRUCTIONS 85 . . N TMPTXT S TMPTXT="" ; BUILD UP INSTRUCTION LINE 86 . . S ZN=0 ; DON'T KNOW WHY 87 . . F ZN=2:1:ZK-1 D ; REMAINING LINES IN EACH MED 88 . . . I MEDRSLT(ZJ+ZN)]"\ Sig: " D ; REMOVE THIS MARKUP 89 . . . . S TMPTXT=TMPTXT_$P(MEDRSLT(ZJ+ZN),"\ Sig: ",2)_" " ; APPEND 2 TMPTXT 90 . . . E S TMPTXT=TMPTXT_MEDRSLT(ZJ+ZN)_" " ; SEPARATE LINES WITH SPACE 91 . . S @MEDVMAP@("MEDDIRECTIONDESCRIPTIONTEXT")=TMPTXT ; CP TO MAP VAR 77 92 . S @MEDVMAP@("MEDDOSEVALUE")="" 78 93 . S @MEDVMAP@("MEDDOSEUNIT")="" … … 82 97 . S @MEDVMAP@("MEDDIRECTIONROUTETEXT")="" 83 98 . S @MEDVMAP@("MEDDIRECTIONFREQUENCYVALUE")="" 84 . S MEDARYTMP=$NA(@MEDTARYTMP@( J))99 . S MEDARYTMP=$NA(@MEDTARYTMP@(ZI)) 85 100 . K @MEDARYTMP 86 101 . D MAP^GPLXPATH(MEDXML,MEDVMAP,MEDARYTMP) 87 . I J=1 D ; FIRST ONE IS JUST A COPY102 . I ZI=1 D ; FIRST ONE IS JUST A COPY 88 103 . . ; W "FIRST ONE",! 89 104 . . D CP^GPLXPATH(MEDARYTMP,MEDOUTXML) 90 . I J>1 D ; AFTER THE FIRST, INSERT INNER XML105 . I ZI>1 D ; AFTER THE FIRST, INSERT INNER XML 91 106 . . D INSINNER^GPLXPATH(MEDOUTXML,MEDARYTMP) 92 107 N MEDTMP,MEDI
Note:
See TracChangeset
for help on using the changeset viewer.