XTERSUM3.m

XTERSUM3 ;ISF/RWF - Transport and save Error summaries ;03/10/11

 ;;8.0;KERNEL;**431**;Jul 10, 1995;Build 38

 ;Per VHA Directive 2004-038, this routine should not be modified.

 Q

 ;

SEND ;Send summary to consolidation site.

 N XMZ,XMY,XMTEXT,XTI,XT1,XT2,XT3,XTFG,FDA,XTNOW

 Q:'$P(^XTV(8989.3,1,"ZTER"),U,2)  ;Check if we should send

 S XT1=0,XTNOW=$$NOW^XLFDT

 L +^%ZTER(3.077,0):15 E  Q  ;Quit if don't get lock

 F  S XT1=$O(^%ZTER(3.077,XT1)) Q:'XT1  D

 . S XT2=$G(^(XT1,0)) I $P(XT2,"^",1)="" D REMOVE(XT1) Q

 . I $P(XT2,U,7)<$P(XT2,U,3) D SND1(XT1) ;Send if UPLOAD < MOST RECENT

 L -^%ZTER(3.077,0)

 Q

 ;

SND1(XT1) ;Send one entry

 N XTX,IEN K ^TMP($J),FDA

 D ADD("$DATA"),ADD("~~ERROR TRAP SUMMARY^3.077"),ADD("$FILE:3.077")

 S IEN=XT1_","

 D GETS^DIQ(3.077,IEN,".01;1;2;3;6;20;7","IN","XTX") ;Fields to get

 S XTI=0

 F  S XTI=$O(XTX(3.077,IEN,XTI)) Q:'XTI  D ADD("~"_XTI_":"_XTX(3.077,IEN,XTI,"I"))

 S XT2=0

 F  S XT2=$O(^%ZTER(3.077,XT1,1,XT2)) Q:'XT2  D

 . I $P(^%ZTER(3.077,XT1,1,XT2,0),U,5) Q

 . K XTX S IEN=XT2_","_XT1_","

 . D GETS^DIQ(3.07701,IEN,".01;1;2;3;13;6","IN","XTX")

 . S FDA(3.07701,IEN,19)=1 ;Mark as sent.

 . S XTI=0 D ADD("$SUB:3.07701")

 . F  S XTI=$O(XTX(3.07701,IEN,XTI)) Q:'XTI  D ADD("~"_XTI_":"_XTX(3.07701,IEN,XTI,"I"))

 . D ADD("$END")

 . Q

 D ADD("$SAVE")

 S FDA(3.077,XT1_",",8)=XTNOW D FILE^DIE("K","FDA") ;Mark as sent.

 Q:'$O(^TMP($J,0))

 N XMDUZ,XMSUB,XMTEXT,XMY,XMSTRIP,XMMG,XMZ

 S XMTEXT="^TMP($J,",XMSUB="ERROR SUMMARY - "_XTNOW

 S XMY("G.XTER SUMMARY LOAD")=""

 D ^XMD

 Q

 ;

ADD(TXT) ;

 S C=$G(^TMP($J)),C=C+1,^TMP($J)=C,^TMP($J,C,0)=TXT

 Q

 ;

 ;This is the server code.

LOAD ;Load Summary

 N XT1,XT2,XT3,FDA,XTF,XTE,XI1,XI2,XTS,XTER,DONE

 S XMER=0,XT1=0,DONE=0,XI1=1,XI2=1,XTS=0

 X XMREC I XMRG'="$DATA" D FORWARD(XMZ) Q  ;Not correct start.

 X XMREC I $E(XMRG,1,4)'="~~ER" D FORWARD(XMZ) Q

 F  X XMREC Q:XMER  D  Q:DONE  ;XMRG has line from msg

 . I $E(XMRG,1,5)="$FILE" S XTF=+$P(XMRG,":",2),XTS=0 Q

 . I $E(XMRG,1,4)="$SUB" S XTF=+$P(XMRG,":",2),XTS=1,XI2=XI2+1 Q

 . I $E(XMRG,1)="~",$L($P(XMRG,":",2)) S FDA(XTF,$$IEN(XI1,XI2,XTS),+$P(XMRG,"~",2))=$P(XMRG,":",2,99) Q

 . I $E(XMRG,1,5)="$SAVE" S DONE=1 Q

 . I $E(XMRG,1,4)="$END" S XTS=0 Q

 . Q

 S XT1=$G(FDA(3.077,$$IEN(1,,0),.01)),XT2=0 S:$L(XT1) XT2=$O(^%ZTER(3.077,"B",XT1,0)) ;See if error allready record.

 I XT2 K FDA(3.077,$$IEN(1,,0),1) ;Remove First seen so don't over write

 I $D(FDA)>2 D UPDATE^DIE("","FDA","XTE","XTER") I $D(XTER) D FORWARD(XMZ)

 Q

 ;

IEN(V1,V2,V3) ;Build an ien

 Q $S('V3:"?+"_V1_",",1:"?+"_V2_",?+"_V1_",")

 ;

FORWARD(XMZ) ;Forward to group to look at error

 N XMY,XMDUZ

 S XMY("G.XTER SUMMARY ERROR")=""

 D ENT1^XMD

 Q

 ;

REMOVE(XTA) ;Remove a dangling count record

 N XTB

 K ^%ZTER(3.077,XTA)

 S XTB=""

 F  S XTB=$O(^%ZTER(3.077,"B",XTB)) Q:XTB=""  I $D(^%ZTER(3.077,"B",XTB,XTA)) K ^%ZTER(3.077,"B",XTB)

 Q

 ;

TESTL ;

 N XMCNT,XMER,XMREC,XMRG

 R !,"Msg#: ",XMZ:DTIME Q:'XMZ

 S XMCNT=.9,XMER=0

 S XMREC="S XMCNT=$O(^XMB(3.9,XMZ,2,XMCNT)) S:'XMCNT XMER=1 Q:XMER  S XMRG=^(XMCNT,0)"

 D LOAD

 Q

XTERSUM3  ;ISF/RWF - Transport and save Error summaries ;03/10/11

 +1       ;;8.0;KERNEL;**431**;Jul 10, 1995;Build 38

 +2       ;Per VHA Directive 2004-038, this routine should not be modified.

 +3        QUIT 

 +4       ;

SEND      ;Send summary to consolidation site.

 +1        NEW XMZ,XMY,XMTEXT,XTI,XT1,XT2,XT3,XTFG,FDA,XTNOW

 +2       ;Check if we should send

           IF '$PIECE(^XTV(8989.3,1,"ZTER"),U,2)

               QUIT 

 +3        SET XT1=0

           SET XTNOW=$$NOW^XLFDT

 +4       ;Quit if don't get lock

           LOCK +^%ZTER(3.077,0):15

          IF '$TEST

               QUIT 

 +5        FOR 

               SET XT1=$ORDER(^%ZTER(3.077,XT1))

               IF 'XT1

                   QUIT 

               Begin DoDot:1

 +6                SET XT2=$GET(^(XT1,0))

                   IF $PIECE(XT2,"^",1)=""

                       DO REMOVE(XT1)

                       QUIT 

 +7       ;Send if UPLOAD < MOST RECENT

                   IF $PIECE(XT2,U,7)<$PIECE(XT2,U,3)

                       DO SND1(XT1)

               End DoDot:1

 +8        LOCK -^%ZTER(3.077,0)

 +9        QUIT 

 +10      ;

SND1(XT1) ;Send one entry

 +1        NEW XTX,IEN

           KILL ^TMP($JOB),FDA

 +2        DO ADD("$DATA")

           DO ADD("~~ERROR TRAP SUMMARY^3.077")

           DO ADD("$FILE:3.077")

 +3        SET IEN=XT1_","

 +4       ;Fields to get

           DO GETS^DIQ(3.077,IEN,".01;1;2;3;6;20;7","IN","XTX")

 +5        SET XTI=0

 +6        FOR 

               SET XTI=$ORDER(XTX(3.077,IEN,XTI))

               IF 'XTI

                   QUIT 

               DO ADD("~"_XTI_":"_XTX(3.077,IEN,XTI,"I"))

 +7        SET XT2=0

 +8        FOR 

               SET XT2=$ORDER(^%ZTER(3.077,XT1,1,XT2))

               IF 'XT2

                   QUIT 

               Begin DoDot:1

 +9                IF $PIECE(^%ZTER(3.077,XT1,1,XT2,0),U,5)

                       QUIT 

 +10               KILL XTX

                   SET IEN=XT2_","_XT1_","

 +11               DO GETS^DIQ(3.07701,IEN,".01;1;2;3;13;6","IN","XTX")

 +12      ;Mark as sent.

                   SET FDA(3.07701,IEN,19)=1

 +13               SET XTI=0

                   DO ADD("$SUB:3.07701")

 +14               FOR 

                       SET XTI=$ORDER(XTX(3.07701,IEN,XTI))

                       IF 'XTI

                           QUIT 

                       DO ADD("~"_XTI_":"_XTX(3.07701,IEN,XTI,"I"))

 +15               DO ADD("$END")

 +16               QUIT 

               End DoDot:1

 +17       DO ADD("$SAVE")

 +18      ;Mark as sent.

           SET FDA(3.077,XT1_",",8)=XTNOW

           DO FILE^DIE("K","FDA")

 +19       IF '$ORDER(^TMP($JOB,0))

               QUIT 

 +20       NEW XMDUZ,XMSUB,XMTEXT,XMY,XMSTRIP,XMMG,XMZ

 +21       SET XMTEXT="^TMP($J,"

           SET XMSUB="ERROR SUMMARY - "_XTNOW

 +22       SET XMY("G.XTER SUMMARY LOAD")=""

 +23       DO ^XMD

 +24       QUIT 

 +25      ;

ADD(TXT)  ;

 +1        SET C=$GET(^TMP($JOB))

           SET C=C+1

           SET ^TMP($JOB)=C

           SET ^TMP($JOB,C,0)=TXT

 +2        QUIT 

 +3       ;

 +4       ;This is the server code.

LOAD      ;Load Summary

 +1        NEW XT1,XT2,XT3,FDA,XTF,XTE,XI1,XI2,XTS,XTER,DONE

 +2        SET XMER=0

           SET XT1=0

           SET DONE=0

           SET XI1=1

           SET XI2=1

           SET XTS=0

 +3       ;Not correct start.

           XECUTE XMREC

           IF XMRG'="$DATA"

               DO FORWARD(XMZ)

               QUIT 

 +4        XECUTE XMREC

           IF $EXTRACT(XMRG,1,4)'="~~ER"

               DO FORWARD(XMZ)

               QUIT 

 +5       ;XMRG has line from msg

           FOR 

               XECUTE XMREC

               IF XMER

                   QUIT 

               Begin DoDot:1

 +6                IF $EXTRACT(XMRG,1,5)="$FILE"

                       SET XTF=+$PIECE(XMRG,":",2)

                       SET XTS=0

                       QUIT 

 +7                IF $EXTRACT(XMRG,1,4)="$SUB"

                       SET XTF=+$PIECE(XMRG,":",2)

                       SET XTS=1

                       SET XI2=XI2+1

                       QUIT 

 +8                IF $EXTRACT(XMRG,1)="~"

                       IF $LENGTH($PIECE(XMRG,":",2))

                           SET FDA(XTF,$$IEN(XI1,XI2,XTS),+$PIECE(XMRG,"~",2))=$PIECE(XMRG,":",2,99)

                           QUIT 

 +9                IF $EXTRACT(XMRG,1,5)="$SAVE"

                       SET DONE=1

                       QUIT 

 +10               IF $EXTRACT(XMRG,1,4)="$END"

                       SET XTS=0

                       QUIT 

 +11               QUIT 

               End DoDot:1

               IF DONE

                   QUIT 

 +12      ;See if error allready record.

           SET XT1=$GET(FDA(3.077,$$IEN(1,,0),.01))

           SET XT2=0

           IF $LENGTH(XT1)

               SET XT2=$ORDER(^%ZTER(3.077,"B",XT1,0))

 +13      ;Remove First seen so don't over write

           IF XT2

               KILL FDA(3.077,$$IEN(1,,0),1)

 +14       IF $DATA(FDA)>2

               DO UPDATE^DIE("","FDA","XTE","XTER")

               IF $DATA(XTER)

                   DO FORWARD(XMZ)

 +15       QUIT 

 +16      ;

IEN(V1,V2,V3) ;Build an ien

 +1        QUIT $SELECT('V3:"?+"_V1_",",1:"?+"_V2_",?+"_V1_",")

 +2       ;

FORWARD(XMZ) ;Forward to group to look at error

 +1        NEW XMY,XMDUZ

 +2        SET XMY("G.XTER SUMMARY ERROR")=""

 +3        DO ENT1^XMD

 +4        QUIT 

 +5       ;

REMOVE(XTA) ;Remove a dangling count record

 +1        NEW XTB

 +2        KILL ^%ZTER(3.077,XTA)

 +3        SET XTB=""

 +4        FOR 

               SET XTB=$ORDER(^%ZTER(3.077,"B",XTB))

               IF XTB=""

                   QUIT 

               IF $DATA(^%ZTER(3.077,"B",XTB,XTA))

                   KILL ^%ZTER(3.077,"B",XTB)

 +5        QUIT 

 +6       ;

TESTL     ;

 +1        NEW XMCNT,XMER,XMREC,XMRG

 +2        READ !,"Msg#: ",XMZ:DTIME

           IF 'XMZ

               QUIT 

 +3        SET XMCNT=.9

           SET XMER=0

 +4        SET XMREC="S XMCNT=$O(^XMB(3.9,XMZ,2,XMCNT)) S:'XMCNT XMER=1 Q:XMER  S XMRG=^(XMCNT,0)"

 +5        DO LOAD

 +6        QUIT