- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/TEXT_INTEGRATION_UTILITIES-GMRP-TIU/TIURL.m
r613 r623 1 TIURL ; SLC/JER - List Management Library ;2/21/01 2 ;;1.0;TEXT INTEGRATION UTILITIES;**88,100,224**;Jun 20, 1997;Build 7 3 ; 11/14/00 Moved UPDATEID, etc to TIURL1 4 ; 5 UPRBLD(TIUCHNG,ITEMS) ; Refreshes, updates, or rebuilds the list 6 ;after various actions. Also restores video. 7 ; Receives optional arrays TIUCHNG, ITEMS by ref. 8 ; Checks TIUCHNG("RBLD"),TIUCHNG("UPDATE"), & TIUCHNG("REFRESH"); 9 ;does nothing if none of these is defined. 10 ; Items in ITEMS list are updated (depending on TIUCHNG), and 11 ;their video attributes are restored. 12 N TIUI,TIUREC,TIUJ,RTN 13 S RTN=$G(^TMP("TIUR",$J,"RTN")) 14 ; -- Restore video attributes for selected items: 15 ; (Rebuild code, except for TIUROR, does its own video restore) 16 I '$G(TIUCHNG("RBLD"))!(RTN="TIUROR") D 17 . S TIUJ=0 18 . F S TIUJ=$O(ITEMS(TIUJ)) Q:'TIUJ D 19 . . Q:TIUJ=$P($G(TIUGLINK),U,2) ; Don't restore midattach ID child 20 . . D RESTORE^VALM10(TIUJ) 21 ; -- If TIUROR screen needs changes, it is always 22 ; rebuilt, not updated: 23 I RTN="TIUROR",$G(TIUCHNG("UPDATE")) S TIUCHNG("RBLD")=1 24 ;VMP/ELR ADDED THE FOLLOWING 2 LINES IN PATCH 224 25 I RTN="TIUR",$G(TIUCHNG("UPDATE")) S TIUCHNG("RBLD")=1 26 I RTN="TIURM",$G(TIUCHNG("UPDATE")) S TIUCHNG("RBLD")=1 27 ; -- Rebuild, Update, or Refresh list: 28 ; (In cases (e.g.browse) where more than one action 29 ; was performed, TIUCHNG("RBLD") may coexist w TIUCHNG("UPDATE"), 30 ; etc., so order is important.) 31 I $G(TIUCHNG("RBLD")) D Q 32 . W !,"Rebuilding the list..." 33 . I RTN="TIUROR" D RBLD^TIUROR Q 34 . ; -- If not in 2b, pause for feedback ("Rebuilding", 35 . ; "Entry deleted", etc): 36 . H 2 37 . I RTN="TIURM" D RBLD^TIURM Q 38 . I RTN="TIURPTTL" D RBLD^TIURPTTL Q 39 . I RTN="TIURTITL" D RBLD^TIURTITL Q 40 . I RTN="TIUR" D RBLD^TIUR 41 I $G(TIUCHNG("UPDATE")),$D(ITEMS) D Q 42 . S TIUI="" 43 . W !,"Updating the list..." 44 . F S TIUI=$O(ITEMS(TIUI)) Q:'TIUI D 45 . . D SETREC(TIUI,.TIUREC) 46 . . ;VMP/ELR ADDED THE FOLLOWING LINE IN PATCH 224 47 . . I $G(TIUREC)="" Q 48 . . S ^TMP("TIUR",$J,TIUI,0)=TIUREC 49 I $G(TIUCHNG("REFRESH")) D Q 50 . W !,"Refreshing the list..." 51 Q 52 ; 53 SETREC(LINENO,TIUREC,PFIXFLAG) ; Update line LINENO with [new prefix], new flds 54 ; Combined fields so that SETREC works for MIS as well as 55 ;CLINICIAN LM templates 56 ; PFIXFLAG=1: update prefix (as well as other flds). 57 ; New prefix is for unexpanded state of line. 58 N DIC,DIQ,DA,DR,TIUR,ADT,DDT,LCT,AUT,AMD,EDT,SDT,TIULST4 59 N MOM,DOC,MISEDT,ITEMNODE 60 S ITEMNODE=^TMP("TIURIDX",$J,LINENO) 61 S DA=+$P(ITEMNODE,U,2) 62 S DIQ="TIUR",DIC=8925,DIQ(0)="IE" 63 S DR=".01;.02;.05;.07;.08;.1;1202;1204;1208;1209;1301;1307;1501;1507" 64 D EN^DIQ1 Q:$D(TIUR)'>9 65 S DOC=$$PNAME^TIULC1(+TIUR(8925,DA,.01,"I")) 66 I DOC="Addendum" D 67 . S MOM=+$P(^TIU(8925,DA,0),U,6) 68 . S DOC=DOC_" to "_$$PNAME^TIULC1(+$G(^TIU(8925,MOM,0))) 69 S TIULST4=$E($P($G(^DPT(TIUR(8925,DA,.02,"I"),0)),U,9),6,9) 70 S TIULST4="("_$E(TIUR(8925,DA,.02,"E"))_TIULST4_")" 71 S ADT=$$DATE^TIULS(TIUR(8925,DA,.07,"I"),"MM/DD/YY") 72 S DDT=$$DATE^TIULS(TIUR(8925,DA,.08,"I"),"MM/DD/YY") 73 S AMD=$$NAME^TIULS(TIUR(8925,DA,1208,"E"),"LAST, FI MI") 74 S AUT=$$NAME^TIULS(TIUR(8925,DA,1202,"E"),"LAST, FI MI") 75 S EDT=$$DATE^TIULS(TIUR(8925,DA,1301,"I"),"MM/DD/YY") 76 S MISEDT=$$DATE^TIULS(TIUR(8925,DA,1307,"I"),"MM/DD/YY") 77 S SDT=$S(+TIUR(8925,DA,1507,"I"):TIUR(8925,DA,1507,"I"),TIUR(8925,DA,.05,"I")'<7:+TIUR(8925,DA,1501,"I"),1:"") 78 S SDT=$$DATE^TIULS(SDT,"MM/DD/YY") 79 S LCT=$G(TIUR(8925,DA,.1,"E")) 80 ; -- Set prefix_patient/title into ^TMP("TIUR",$J,LINENO,0), 81 ; then into TIUREC: -- 82 I $G(PFIXFLAG) D SETPT^TIURL1(LINENO) 83 S TIUREC=^TMP("TIUR",$J,LINENO,0) 84 ; -- Set other fields into TIUREC: -- 85 S TIUREC=$$SETFLD^VALM1(LINENO,TIUREC,"NUMBER") 86 S TIUREC=$$SETFLD^VALM1($$LOWER^TIULS(TIUR(8925,DA,.05,"E")),TIUREC,"STATUS") 87 S TIUREC=$$SETFLD^VALM1(TIULST4,TIUREC,"LAST I/LAST 4") 88 S TIUREC=$$SETFLD^VALM1(DOC,TIUREC,"DOCUMENT TYPE") 89 S:$D(VALMDDF("ADMISSION DATE")) TIUREC=$$SETFLD^VALM1(ADT,TIUREC,"ADMISSION DATE") 90 S:$D(VALMDDF("DISCH DATE")) TIUREC=$$SETFLD^VALM1(AMD,TIUREC,"DISCH DATE") 91 S:$D(VALMDDF("DICT DATE")) TIUREC=$$SETFLD^VALM1(MISEDT,TIUREC,"DICT DATE") 92 S:$D(VALMDDF("LINE COUNT")) TIUREC=$$SETFLD^VALM1(LCT,TIUREC,"LINE COUNT") 93 S:$D(VALMDDF("REF DATE")) TIUREC=$$SETFLD^VALM1(EDT,TIUREC,"REF DATE") 94 S:$D(VALMDDF("SIG DATE")) TIUREC=$$SETFLD^VALM1(SDT,TIUREC,"SIG DATE") 95 S TIUREC=$$SETFLD^VALM1(AUT,TIUREC,"AUTHOR") 96 S:$D(VALMDDF("COSIGNER")) TIUREC=$$SETFLD^VALM1(AMD,TIUREC,"COSIGNER") 97 S:$D(VALMDDF("ATTENDING")) TIUREC=$$SETFLD^VALM1(AMD,TIUREC,"ATTENDING") 98 S ^TMP("TIUR",$J,LINENO,0)=TIUREC 99 Q 1 TIURL ; SLC/JER - List Management Library ;2/21/01 2 ;;1.0;TEXT INTEGRATION UTILITIES;**88,100**;Jun 20, 1997 3 ; 11/14/00 Moved UPDATEID, etc to TIURL1 4 ; 5 UPRBLD(TIUCHNG,ITEMS) ; Refreshes, updates, or rebuilds the list 6 ;after various actions. Also restores video. 7 ; Receives optional arrays TIUCHNG, ITEMS by ref. 8 ; Checks TIUCHNG("RBLD"),TIUCHNG("UPDATE"), & TIUCHNG("REFRESH"); 9 ;does nothing if none of these is defined. 10 ; Items in ITEMS list are updated (depending on TIUCHNG), and 11 ;their video attributes are restored. 12 N TIUI,TIUREC,TIUJ,RTN 13 S RTN=$G(^TMP("TIUR",$J,"RTN")) 14 ; -- Restore video attributes for selected items: 15 ; (Rebuild code, except for TIUROR, does its own video restore) 16 I '$G(TIUCHNG("RBLD"))!(RTN="TIUROR") D 17 . S TIUJ=0 18 . F S TIUJ=$O(ITEMS(TIUJ)) Q:'TIUJ D 19 . . Q:TIUJ=$P($G(TIUGLINK),U,2) ; Don't restore midattach ID child 20 . . D RESTORE^VALM10(TIUJ) 21 ; -- If TIUROR screen needs changes, it is always 22 ; rebuilt, not updated: 23 I RTN="TIUROR",$G(TIUCHNG("UPDATE")) S TIUCHNG("RBLD")=1 24 ; -- Rebuild, Update, or Refresh list: 25 ; (In cases (e.g.browse) where more than one action 26 ; was performed, TIUCHNG("RBLD") may coexist w TIUCHNG("UPDATE"), 27 ; etc., so order is important.) 28 I $G(TIUCHNG("RBLD")) D Q 29 . W !,"Rebuilding the list..." 30 . I RTN="TIUROR" D RBLD^TIUROR Q 31 . ; -- If not in 2b, pause for feedback ("Rebuilding", 32 . ; "Entry deleted", etc): 33 . H 2 34 . I RTN="TIURM" D RBLD^TIURM Q 35 . I RTN="TIURPTTL" D RBLD^TIURPTTL Q 36 . I RTN="TIURTITL" D RBLD^TIURTITL Q 37 . I RTN="TIUR" D RBLD^TIUR 38 I $G(TIUCHNG("UPDATE")),$D(ITEMS) D Q 39 . S TIUI="" 40 . W !,"Updating the list..." 41 . F S TIUI=$O(ITEMS(TIUI)) Q:'TIUI D 42 . . D SETREC(TIUI,.TIUREC) 43 . . S ^TMP("TIUR",$J,TIUI,0)=TIUREC 44 I $G(TIUCHNG("REFRESH")) D Q 45 . W !,"Refreshing the list..." 46 Q 47 ; 48 SETREC(LINENO,TIUREC,PFIXFLAG) ; Update line LINENO with [new prefix], new flds 49 ; Combined fields so that SETREC works for MIS as well as 50 ;CLINICIAN LM templates 51 ; PFIXFLAG=1: update prefix (as well as other flds). 52 ; New prefix is for unexpanded state of line. 53 N DIC,DIQ,DA,DR,TIUR,ADT,DDT,LCT,AUT,AMD,EDT,SDT,TIULST4 54 N MOM,DOC,MISEDT,ITEMNODE 55 S ITEMNODE=^TMP("TIURIDX",$J,LINENO) 56 S DA=+$P(ITEMNODE,U,2) 57 S DIQ="TIUR",DIC=8925,DIQ(0)="IE" 58 S DR=".01;.02;.05;.07;.08;.1;1202;1204;1208;1209;1301;1307;1501;1507" 59 D EN^DIQ1 Q:$D(TIUR)'>9 60 S DOC=$$PNAME^TIULC1(+TIUR(8925,DA,.01,"I")) 61 I DOC="Addendum" D 62 . S MOM=+$P(^TIU(8925,DA,0),U,6) 63 . S DOC=DOC_" to "_$$PNAME^TIULC1(+$G(^TIU(8925,MOM,0))) 64 S TIULST4=$E($P($G(^DPT(TIUR(8925,DA,.02,"I"),0)),U,9),6,9) 65 S TIULST4="("_$E(TIUR(8925,DA,.02,"E"))_TIULST4_")" 66 S ADT=$$DATE^TIULS(TIUR(8925,DA,.07,"I"),"MM/DD/YY") 67 S DDT=$$DATE^TIULS(TIUR(8925,DA,.08,"I"),"MM/DD/YY") 68 S AMD=$$NAME^TIULS(TIUR(8925,DA,1208,"E"),"LAST, FI MI") 69 S AUT=$$NAME^TIULS(TIUR(8925,DA,1202,"E"),"LAST, FI MI") 70 S EDT=$$DATE^TIULS(TIUR(8925,DA,1301,"I"),"MM/DD/YY") 71 S MISEDT=$$DATE^TIULS(TIUR(8925,DA,1307,"I"),"MM/DD/YY") 72 S SDT=$S(+TIUR(8925,DA,1507,"I"):TIUR(8925,DA,1507,"I"),TIUR(8925,DA,.05,"I")'<7:+TIUR(8925,DA,1501,"I"),1:"") 73 S SDT=$$DATE^TIULS(SDT,"MM/DD/YY") 74 S LCT=$G(TIUR(8925,DA,.1,"E")) 75 ; -- Set prefix_patient/title into ^TMP("TIUR",$J,LINENO,0), 76 ; then into TIUREC: -- 77 I $G(PFIXFLAG) D SETPT^TIURL1(LINENO) 78 S TIUREC=^TMP("TIUR",$J,LINENO,0) 79 ; -- Set other fields into TIUREC: -- 80 S TIUREC=$$SETFLD^VALM1(LINENO,TIUREC,"NUMBER") 81 S TIUREC=$$SETFLD^VALM1($$LOWER^TIULS(TIUR(8925,DA,.05,"E")),TIUREC,"STATUS") 82 S TIUREC=$$SETFLD^VALM1(TIULST4,TIUREC,"LAST I/LAST 4") 83 S TIUREC=$$SETFLD^VALM1(DOC,TIUREC,"DOCUMENT TYPE") 84 S:$D(VALMDDF("ADMISSION DATE")) TIUREC=$$SETFLD^VALM1(ADT,TIUREC,"ADMISSION DATE") 85 S:$D(VALMDDF("DISCH DATE")) TIUREC=$$SETFLD^VALM1(AMD,TIUREC,"DISCH DATE") 86 S:$D(VALMDDF("DICT DATE")) TIUREC=$$SETFLD^VALM1(MISEDT,TIUREC,"DICT DATE") 87 S:$D(VALMDDF("LINE COUNT")) TIUREC=$$SETFLD^VALM1(LCT,TIUREC,"LINE COUNT") 88 S:$D(VALMDDF("REF DATE")) TIUREC=$$SETFLD^VALM1(EDT,TIUREC,"REF DATE") 89 S:$D(VALMDDF("SIG DATE")) TIUREC=$$SETFLD^VALM1(SDT,TIUREC,"SIG DATE") 90 S TIUREC=$$SETFLD^VALM1(AUT,TIUREC,"AUTHOR") 91 S:$D(VALMDDF("COSIGNER")) TIUREC=$$SETFLD^VALM1(AMD,TIUREC,"COSIGNER") 92 S:$D(VALMDDF("ATTENDING")) TIUREC=$$SETFLD^VALM1(AMD,TIUREC,"ATTENDING") 93 S ^TMP("TIUR",$J,LINENO,0)=TIUREC 94 Q
Note:
See TracChangeset
for help on using the changeset viewer.
