source: WorldVistAEHR/trunk/r/LEXICON_UTILITY-LEX-GMPT/LEXAR7.m@ 1093

Last change on this file since 1093 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 4.2 KB
Line 
1LEXAR7 ; ISL Look-up Response (MAIL) ; 05/14/2003
2 ;;2.0;LEXICON UTILITY;**9,25**;Sep 23, 1996;Build 1
3 ;
4 Q
5 ; This routines sends a Mailman message containing the Unresolved
6 ; Narratives and Comments stored in file 757.06 to the Field Office
7 ; at G.LEXUNR@ISC-SLC.VA.GOV. Once sent, the Unresolved Narratives
8 ; and comments are purged from file 757.06. Both the Unresolved
9 ; Narratives and comments are used to update the Lexicon Utility.
10 ;
11SEND ; Task MAILMAN to Send Unresolved Narratives to the ISC
12 I +($$TOT^LEXAR6)'>49!('$L($G(^LEX(757.06,0))))!(+($P($G(^LEX(757.06,0)),"^",4))<1) G SENDQ
13 G:$D(^TMP("LEXSEND")) SENDQ S ^TMP("LEXSEND")=""
14 N X,Y,ZTQUEUED,ZTREQ,ZTSK,ZTDESC,ZTDTH,ZTIO,ZTRTN,%,%X,%Y
15 S ZTRTN="ISC^LEXAR7",ZTDESC="Sending Narratives to IRMFO",ZTIO="",ZTDTH=$H D ^%ZTLOAD,HOME^%ZIS
16SENDQ ; End of Send
17 K ZTSK,ZTDESC,ZTDTH,ZTIO,ZTRTN
18 Q
19DUMP ; Dump Narratives to Developer
20 D HOME^%ZIS S U="^" Q:+($G(DUZ))=0 Q:+($O(^LEX(757.06,0)))'>0
21 S ^TMP("LEXSEND")="" K ^TMP("LEXMSG",$J) D ISC K ^TMP("LEXSEND")
22 Q
23ISC ; Create MAILMAN Message for the IRMFO
24 G:'$D(^TMP("LEXSEND")) ISCQ G:$D(^TMP("LEXMSG")) ISCQ
25 ;
26 ; LEXT Narrative Type
27 ; LEXN Narrative
28 ; LEXA # of Narratives Added to Message
29 ;
30 N DA,DIC,DIK,DIE,X,Y,LEXT,LEXN,LEXA S:$D(ZTQUEUED) ZTREQ="@" D INM S DA=0,DIK="^LEX(757.06,",LEXA=0
31 F S DA=$O(^LEX(757.06,DA)) Q:+DA=0 D
32 . S LEXT="UNR"
33 . I '$D(^LEX(757.06,DA,1)),'$D(^LEX(757.06,DA,2)),'$D(^LEX(757.06,DA,3)),$D(^LEX(757.06,DA,4)) S LEXT="COM"
34 . Q:+($G(^LEX(757.06,DA,99)))'>0
35 . S LEXN=$P($G(^LEX(757.06,DA,0)),"^",1) Q:'$L(LEXN) Q:'$D(^LEX(757.06,"B",$E(LEXN,1,30),DA))
36 . Q:+($G(LEXA))>50
37 . D ADD(" ",LEXT) S LEXA=LEXA+1
38 . I $L($P($G(^LEX(757.06,DA,0)),U,1)) D
39 . . I LEXT="UNR" D ADD("NAR",$P($G(^LEX(757.06,DA,0)),U,1,2)) Q
40 . . D ADD("EXP",$P($G(^LEX(757.06,DA,0)),U,1)) Q
41 . D:$L($P($G(^LEX(757.06,DA,0)),U,3)) ADD("SCH",$P($G(^LEX(757.06,DA,0)),U,3))
42 . D:$L($P($G(^LEX(757.06,DA,0)),U,4)) ADD("FND",$P($G(^LEX(757.06,DA,0)),U,4))
43 . D:$L($P($G(^LEX(757.06,DA,1)),U,1)) ADD("APP",$P($G(^LEX(757.06,DA,1)),U,1))
44 . D:$L($P($G(^LEX(757.06,DA,1)),U,2)) ADD("SER",$P($G(^LEX(757.06,DA,1)),U,2))
45 . D:$L($P($G(^LEX(757.06,DA,1)),U,3)) ADD("LOC",$P($G(^LEX(757.06,DA,1)),U,3))
46 . D:$L($P($G(^LEX(757.06,DA,2)),U,1)) ADD("FLN",$P($G(^LEX(757.06,DA,2)),U,1))
47 . D:$L($P($G(^LEX(757.06,DA,2)),U,2)) ADD("IDX",$P($G(^LEX(757.06,DA,2)),U,2))
48 . D:$L($P($G(^LEX(757.06,DA,2)),U,3)) ADD("SCT",$P($G(^LEX(757.06,DA,2)),U,3))
49 . D:$L($G(^LEX(757.06,DA,3))) ADD("SCR",$G(^LEX(757.06,DA,3)))
50 . D:$L($P($G(^LEX(757.06,DA,4)),U,1)) ADD("IEN",$P($G(^LEX(757.06,DA,4)),U,1))
51 . D:$L($P($G(^LEX(757.06,DA,4)),U,2)) ADD("COM",$P($G(^LEX(757.06,DA,4)),U,2))
52 . I +($G(DA))>0 K ^LEX(757.06,+($G(DA)),99) D:$D(^LEX(757.06,+($G(DA)),0)) ^DIK
53 D N0,MAIL S LEXA=$$TOT^LEXAR6
54ISCQ ; End of Send MAILMAN Message
55 K LEXA,LEXN,LEXT S:$D(ZTQUEUED) ZTREQ="@"
56 Q
57ADD(LEXI,LEXS) ; Add text to message
58 ;
59 ; LEXI Narrative Segment ID
60 ; LEXS Segment String
61 ; LEXC Counter/IEN for ^TMP("LEXMSG",$J,LEXC)
62 ;
63 N LEXC S LEXC=+($G(^TMP("LEXMSG",$J,0)))+1,^TMP("LEXMSG",$J,0)=LEXC,^TMP("LEXMSG",$J,LEXC)=LEXI
64 S:$G(LEXS)'="" ^TMP("LEXMSG",$J,LEXC)=^TMP("LEXMSG",$J,LEXC)_"^"_LEXS
65 Q
66MAIL ; MAILMAN
67 N XCNP,XMDUZ,XMSUB,XMTEXT,XMY,XMZ,Y,LEXADR S LEXADR=$$ADR^LEXU G:'$L(LEXADR) MAILQ
68 G:'$D(^TMP("LEXMSG",$J)) MAILQ G:+($G(LEXA))=0 MAILQ G:+($G(^TMP("LEXMSG",$J,0)))=0 MAILQ
69 K XMZ N DIFROM S XMSUB="Unresolved Narratives - "_LEXA_" items"
70 S XMY(("G.LEXUNR@"_LEXADR))="",XMTEXT="^TMP(""LEXMSG"",$J,",XMDUZ=.5 D ^XMD
71MAILQ ; End of MAILMAN
72 K ^TMP("LEXSEND"),^TMP("LEXMSG",$J),DIFROM,LEXA,XCNP,XMDUZ,XMZ,XMSUB,XMY,XMTEXT,XMDUZ,XMSCR,REF,%,%X,%Y,%Z Q
73INM ; Initialize Message
74 N LEXI S (LEXI,^TMP("LEXMSG",$J,0))=0 F S LEXI=$O(^TMP("LEXMSG",$J,LEXI)) Q:+LEXI=0 K ^TMP("LEXMSG",$J,LEXI)
75 Q
76N0 ; ^LEX(757.06,0)
77 N LEX3,LEX4,DA S (LEX3,LEX4,DA)=0 F S DA=$O(^LEX(757.06,DA)) Q:+DA=0 S LEX3=DA,LEX4=LEX4+1
78 S LEX3=+LEX3,LEX4=+LEX4 S:+LEX3=0 LEX3="" S:+LEX4=0 LEX4="" S ^LEX(757.06,0)=$P($G(^LEX(757.06,0)),"^",1,2)_"^"_LEX3_"^"_LEX4
79 Q
80CLR ; Clear all narratives
81 N DA,DIK S DA=0,U="^",DIK="^LEX(757.06," F S DA=$O(^LEX(757.06,DA)) Q:+DA=0 D ^DIK
82 N LEXN S LEXN=$P(^LEX(757.06,0),"^",1,2)_"^^" S ^LEX(757.06,0)=LEXN
83 Q
Note: See TracBrowser for help on using the repository browser.