Changeset 623 for WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LR7OGMG.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
-
WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LR7OGMG.m (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LR7OGMG.m
r613 r623 1 LR7OGMG ;DALOI/STAFF- Interim report rpc memo grid ;July 19, 2006 2 ;;5.2;LAB SERVICE;**187,230,286,290,331,364**;Sep 27, 1994;Build 3 3 ; 4 GRID(OUTCNT) ; from LR7OGMC 5 N ACC,AGE,CDT,CMNT,DATA,DOC,FLAG,IDT,INTP,LINE,LRCW,LRX,MPLS,PLS,PORDER,PRNTCODE,RANGE,SEX,SPEC,SUB,TCNT,TESTNAME,TESTNUM 6 N UNITS,VALUE,X,ZERO,INEXACT,DISPDATE 7 ; the variables AGE, SEX, LRCW, and X are used withing the lab's print codes and ref ranges 8 K ^TMP("LRMPLS",$J) 9 S AGE=$P(^TMP("LR7OG",$J,"G"),U,4),SEX=$P(^("G"),U,5),LRCW=$P(^("G"),U,6) 10 S CDT=+$O(^TMP("LR7OG",$J,"TP",0)) Q:'CDT 11 S IDT=9999999-CDT 12 S ZERO=$S($D(^TMP("LR7OG",$J,"TP",CDT))#2:^(CDT),1:"") 13 I '$P(ZERO,U,3) Q 14 S SPEC=+$P(ZERO,U,5) 15 S INEXACT=$P(ZERO,U,2),DISPDATE=$S(INEXACT:CDT\1,1:CDT) 16 S DOC=$$NAME^LR7OGMP(+$P(ZERO,U,10)) 17 S ACC=$P(ZERO,U,6) 18 S $P(^TMP("LR7OGX",$J,"OUTPUT",1),U,4,6)=SPEC_U_$P($G(^LAB(61,SPEC,0)),U)_U_ACC_U_DOC 19 S $P(^TMP("LR7OGX",$J,"OUTPUT",1),U,10)=DISPDATE 20 S (TCNT,MPLS,PORDER,PLS)=0 21 S PLS=$O(^TMP("LRPLS",$J,0)) 22 I $O(^TMP("LRPLS",$J,PLS)) S MPLS=1 ; multiple performing labs 23 F S PORDER=$O(^TMP("LR7OG",$J,"TP",CDT,PORDER)) Q:PORDER'>0 S DATA=^(PORDER) D 24 . I $P(DATA,U,7)="" Q 25 . S TCNT=TCNT+1 26 . S TESTNUM=+DATA,TESTNAME=$P(DATA,U,2),PRNTCODE=$P(DATA,U,5),SUB=$P(DATA,U,6),FLAG=$P(DATA,U,8),X=$P(DATA,U,7),UNITS=$P(DATA,U,9),RANGE=$P(DATA,U,10),PLS=$P(DATA,U,11) 27 . I MPLS,PLS S ^TMP("LRMPLS",$J,PLS,TESTNAME)="" 28 . I PRNTCODE="" S VALUE=$J(X,8) 29 . E S @("VALUE="_PRNTCODE) 30 . S ^TMP("LR7OGX",$J,"OUTPUT",OUTCNT)=TESTNUM_U_TESTNAME_U_VALUE_U_FLAG_U_UNITS_U_RANGE 31 . S OUTCNT=OUTCNT+1 32 S $P(^TMP("LR7OGX",$J,"OUTPUT",1),U)=TCNT 33 ; 34 S PORDER=0 35 F S PORDER=$O(^TMP("LR7OG",$J,"TP",CDT,PORDER)) Q:PORDER'>0 S DATA=^(PORDER) D 36 . I $O(^TMP("LR7OG",$J,"TP",CDT,PORDER,0))>0 D 37 . . S TESTNAME=$P(DATA,U,3) 38 . . S INTP=0 39 . . F S INTP=+$O(^TMP("LR7OG",$J,"TP",CDT,PORDER,INTP)) Q:INTP<1 D 40 . . . S LINE=TESTNAME_" Eval: "_^TMP("LR7OG",$J,"TP",CDT,PORDER,INTP) 41 . . . S ^TMP("LR7OGX",$J,"OUTPUT",OUTCNT)=LINE 42 . . . S OUTCNT=OUTCNT+1 43 ; 44 I $D(^TMP("LR7OG",$J,"TP",CDT,"C")) D 45 . S ^TMP("LR7OGX",$J,"OUTPUT",OUTCNT)="Comment: " 46 . S OUTCNT=OUTCNT+1,CMNT=0 47 . F S CMNT=+$O(^TMP("LR7OG",$J,"TP",CDT,"C",CMNT)) Q:CMNT<1 S LINE=^(CMNT) D 48 . . S ^TMP("LR7OGX",$J,"OUTPUT",OUTCNT)=" "_LINE 49 . . S OUTCNT=OUTCNT+1 50 ; 51 D PLS 52 Q 53 ; 54 ; 55 PLS ; List performing laboratories 56 ; If multiple performing labs then list tests associated with each lab. 57 ; 58 N CNT,LINE,LRPLS,X 59 S (CNT,LRPLS)=0 60 F S LRPLS=$O(^TMP("LRPLS",$J,LRPLS)) Q:LRPLS<1 D 61 . I CNT S ^TMP("LR7OGX",$J,"OUTPUT",OUTCNT)=" ",OUTCNT=OUTCNT+1 62 . I $D(^TMP("LRMPLS",$J,LRPLS)) D 63 . . S TESTNAME="",LINE="For test(s): " 64 . . F S TESTNAME=$O(^TMP("LRMPLS",$J,LRPLS,TESTNAME)) Q:TESTNAME="" D 65 . . . I ($L(LINE)+$L(TESTNAME))>240 D 66 . . . . S ^TMP("LR7OGX",$J,"OUTPUT",OUTCNT)=LINE 67 . . . . S OUTCNT=OUTCNT+1,LINE="" 68 . . . S LINE=LINE_TESTNAME_", " 69 . . S ^TMP("LR7OGX",$J,"OUTPUT",OUTCNT)=LINE,OUTCNT=OUTCNT+1 70 . S LINE=$$NAME^XUAF4(LRPLS) 71 . S X=$$PADD^XUAF4(LRPLS) 72 . S LINE=LINE_" "_$P(X,U)_" "_$P(X,U,2)_", "_$P(X,U,3)_" "_$P(X,U,4) 73 . S ^TMP("LR7OGX",$J,"OUTPUT",OUTCNT)="Performing Lab: "_LINE 74 . S OUTCNT=OUTCNT+1,CNT=CNT+1 75 ; 76 K ^TMP("LRPLS",$J),^TMP("LRMPLS",$J) 77 Q 1 LR7OGMG ;DALOI/STAFF- Interim report rpc memo grid ;July 19, 2006 2 ;;5.2;LAB SERVICE;**187,230,286,290,331**;Sep 27, 1994;Build 7 3 ; 4 GRID(OUTCNT) ; from LR7OGMC 5 N ACC,AGE,CDT,CMNT,DATA,DOC,FLAG,IDT,INTP,LINE,LRCW,LRX,MPLS,PLS,PORDER,PRNTCODE,RANGE,SEX,SPEC,SUB,TCNT,TESTNAME,TESTNUM 6 N UNITS,VALUE,X,ZERO 7 ; the variables AGE, SEX, LRCW, and X are used withing the lab's print codes and ref ranges 8 K ^TMP("LRMPLS",$J) 9 S AGE=$P(^TMP("LR7OG",$J,"G"),U,4),SEX=$P(^("G"),U,5),LRCW=$P(^("G"),U,6) 10 S CDT=+$O(^TMP("LR7OG",$J,"TP",0)) Q:'CDT 11 S IDT=9999999-CDT 12 S ZERO=$S($D(^TMP("LR7OG",$J,"TP",CDT))#2:^(CDT),1:"") 13 I '$P(ZERO,U,3) Q 14 S SPEC=+$P(ZERO,U,5) 15 S DOC=$$NAME^LR7OGMP(+$P(ZERO,U,10)) 16 S ACC=$P(ZERO,U,6) 17 S $P(^TMP("LR7OGX",$J,"OUTPUT",1),U,4,6)=SPEC_U_$P($G(^LAB(61,SPEC,0)),U)_U_ACC_U_DOC 18 S (TCNT,MPLS,PORDER,PLS)=0 19 S PLS=$O(^TMP("LRPLS",$J,0)) 20 I $O(^TMP("LRPLS",$J,PLS)) S MPLS=1 ; multiple performing labs 21 F S PORDER=$O(^TMP("LR7OG",$J,"TP",CDT,PORDER)) Q:PORDER'>0 S DATA=^(PORDER) D 22 . I $P(DATA,U,7)="" Q 23 . S TCNT=TCNT+1 24 . S TESTNUM=+DATA,TESTNAME=$P(DATA,U,2),PRNTCODE=$P(DATA,U,5),SUB=$P(DATA,U,6),FLAG=$P(DATA,U,8),X=$P(DATA,U,7),UNITS=$P(DATA,U,9),RANGE=$P(DATA,U,10),PLS=$P(DATA,U,11) 25 . I MPLS,PLS S ^TMP("LRMPLS",$J,PLS,TESTNAME)="" 26 . I PRNTCODE="" S VALUE=$J(X,8) 27 . E S @("VALUE="_PRNTCODE) 28 . S ^TMP("LR7OGX",$J,"OUTPUT",OUTCNT)=TESTNUM_U_TESTNAME_U_VALUE_U_FLAG_U_UNITS_U_RANGE 29 . S OUTCNT=OUTCNT+1 30 S $P(^TMP("LR7OGX",$J,"OUTPUT",1),U)=TCNT 31 ; 32 S PORDER=0 33 F S PORDER=$O(^TMP("LR7OG",$J,"TP",CDT,PORDER)) Q:PORDER'>0 S DATA=^(PORDER) D 34 . I $O(^TMP("LR7OG",$J,"TP",CDT,PORDER,0))>0 D 35 . . S TESTNAME=$P(DATA,U,3) 36 . . S INTP=0 37 . . F S INTP=+$O(^TMP("LR7OG",$J,"TP",CDT,PORDER,INTP)) Q:INTP<1 D 38 . . . S LINE=TESTNAME_" Eval: "_^TMP("LR7OG",$J,"TP",CDT,PORDER,INTP) 39 . . . S ^TMP("LR7OGX",$J,"OUTPUT",OUTCNT)=LINE 40 . . . S OUTCNT=OUTCNT+1 41 ; 42 I $D(^TMP("LR7OG",$J,"TP",CDT,"C")) D 43 . S ^TMP("LR7OGX",$J,"OUTPUT",OUTCNT)="Comment: " 44 . S OUTCNT=OUTCNT+1,CMNT=0 45 . F S CMNT=+$O(^TMP("LR7OG",$J,"TP",CDT,"C",CMNT)) Q:CMNT<1 S LINE=^(CMNT) D 46 . . S ^TMP("LR7OGX",$J,"OUTPUT",OUTCNT)=" "_LINE 47 . . S OUTCNT=OUTCNT+1 48 ; 49 D PLS 50 Q 51 ; 52 ; 53 PLS ; List performing laboratories 54 ; If multiple performing labs then list tests associated with each lab. 55 ; 56 N CNT,LINE,LRPLS,X 57 S (CNT,LRPLS)=0 58 F S LRPLS=$O(^TMP("LRPLS",$J,LRPLS)) Q:LRPLS<1 D 59 . I CNT S ^TMP("LR7OGX",$J,"OUTPUT",OUTCNT)=" ",OUTCNT=OUTCNT+1 60 . I $D(^TMP("LRMPLS",$J,LRPLS)) D 61 . . S TESTNAME="",LINE="For test(s): " 62 . . F S TESTNAME=$O(^TMP("LRMPLS",$J,LRPLS,TESTNAME)) Q:TESTNAME="" D 63 . . . I ($L(LINE)+$L(TESTNAME))>240 D 64 . . . . S ^TMP("LR7OGX",$J,"OUTPUT",OUTCNT)=LINE 65 . . . . S OUTCNT=OUTCNT+1,LINE="" 66 . . . S LINE=LINE_TESTNAME_", " 67 . . S ^TMP("LR7OGX",$J,"OUTPUT",OUTCNT)=LINE,OUTCNT=OUTCNT+1 68 . S LINE=$$NAME^XUAF4(LRPLS) 69 . S X=$$PADD^XUAF4(LRPLS) 70 . S LINE=LINE_" "_$P(X,U)_" "_$P(X,U,2)_", "_$P(X,U,3)_" "_$P(X,U,4) 71 . S ^TMP("LR7OGX",$J,"OUTPUT",OUTCNT)="Performing Lab: "_LINE 72 . S OUTCNT=OUTCNT+1,CNT=CNT+1 73 ; 74 K ^TMP("LRPLS",$J),^TMP("LRMPLS",$J) 75 Q
Note:
See TracChangeset
for help on using the changeset viewer.
