AGGPTTRG.m

AGGPTTRG ;VNGT/HS/ALA-Patient Detail Triggers ; 27 May 2010  4:25 PM

 ;;1.0;PATIENT REGISTRATION GUI;;Nov 15, 2010

 ;

 ;

INIT(DATA,DFN) ;EP -- AGG PERSONAL DETAIL TRIGGER

 ; Input

 ;   DFN      - Patient IEN

 ;

 NEW UID,II,VALUE,SOURCE,IEN,HELP,TYPE,ABLE,NOSAVE,AGGPTSSV,DOBE,SSNV

 S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)

 S DATA=$NA(^TMP("AGGTRPAT",UID))

 K @DATA

 S II=0

 NEW $ESTACK,$ETRAP S $ETRAP="D ERR^AGGWTRIG D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2

 D HDR

 S @DATA@(II)=HDR_$C(30)

 ;

 S DOBE=$P($G(^AGFAC(DUZ(2),0)),U,13),SSNV=$P(^AUPNPAT(DFN,0),U,23)

 F SOURCE="AGGPTLNM","AGGPTFNM","AGGPTMNM","AGGPTSFX" S ABLE="N",VALUE="",TYPE="X",HELP="",CLEAR="",NOSAVE="N" D UP

 I $D(^XUSEC("AGZMGR",DUZ)) D

 . S SOURCE="AGGPTHRN",ABLE="Y",VALUE="",TYPE="X",HELP="",CLEAR="",NOSAVE="N" D UP

 . I SSNV'="","XV"[$P(^AUTTSSN(SSNV,0),U) D  Q

 .. S SOURCE="AGGPTDOB",ABLE="Y",VALUE="",TYPE="D",HELP="The NAME/SSN/DOB have been Verified by the SSA do not change the DOB unless you are certain that it is incorrect!" D UP

 . S SOURCE="AGGPTDOB",ABLE="Y",VALUE="",TYPE="X",HELP="",CLEAR="",NOSAVE="N" D UP

 I '$D(^XUSEC("AGZMGR",DUZ)) D

 . S SOURCE="AGGPTHRN",ABLE="N",VALUE="",TYPE="X",HELP="",CLEAR="",NOSAVE="N" D UP

 . I SSNV'="","XV"[$P(^AUTTSSN(SSNV,0),U) D  Q

 .. I DOBE="Y" S SOURCE="AGGPTDOB",ABLE="N",VALUE="",TYPE="D",HELP="DOB must be edited by a supervisor." D UP

 .. I DOBE="N" S SOURCE="AGGPTDOB",ABLE="Y",VALUE="",TYPE="D",HELP="The NAME/SSN/DOB have been Verified by the SSA do not change the DOB unless you are certain that it is incorrect!" D UP

 . I DOBE="Y" S SOURCE="AGGPTDOB",ABLE="N",VALUE="",TYPE="X",HELP="DOB must be edited by a supervisor.",CLEAR="",NOSAVE="N" D UP

 . I DOBE="N" S SOURCE="AGGPTDOB",ABLE="Y",VALUE="",TYPE="X",HELP="",CLEAR="",NOSAVE="N" D UP

 ;

 S AGGPTSSV=$$GET1^DIQ(9000001,DFN_",",.23,"E")

 S AGGNOSSN=$$GET1^DIQ(9000001,DFN_",",.24,"E")

 S AGGPTSSN=$$GET1^DIQ(2,DFN_",",.09,"E")

 S SSN=$$GET1^DIQ(2,DFN_",",.09,"E")

 ;

 I AGGPTSSN'="",AGGNOSSN="" D

 . S SOURCE="AGGNOSSN",ABLE="N",VALUE="",TYPE="X",HELP="",CLEAR="",NOSAVE="N" D UP

 . I AGGPTSSV="P"!(AGGPTSSV="") S SOURCE="AGGPTSSN",ABLE="Y",VALUE="",TYPE="X",HELP="",CLEAR="",NOSAVE="N" D UP

 . I AGGPTSSV'="P",AGGPTSSV'="" S SOURCE="AGGPTSSN",ABLE="N",VALUE="",TYPE="X",HELP="",CLEAR="",NOSAVE="Y" D UP

 I AGGPTSSN="",AGGNOSSN'="" D

 . S SOURCE="AGGNOSSN",ABLE="Y",VALUE="",TYPE="X",HELP="",CLEAR="",NOSAVE="N" D UP

 . S SOURCE="AGGPTSSN",ABLE="N",VALUE="",TYPE="X",HELP="",CLEAR="",NOSAVE="Y" D UP

 I AGGPTSSN="",AGGNOSSN="" D

 . S SOURCE="AGGNOSSN",ABLE="Y",VALUE="",TYPE="X",HELP="",CLEAR="",NOSAVE="N" D UP

 . S SOURCE="AGGPTSSN",ABLE="N",VALUE="",TYPE="X",HELP="",CLEAR="",NOSAVE="N" D UP

 ;

 S HRN=$$HRN^AGGUL1(DFN)

 I $E(HRN,1,1)="T",$D(^XUSEC("AGZMGR",DUZ)) S SOURCE="AGGPTHRN",ABLE="Y",VALUE="",TYPE="X",HELP="",CLEAR="",NOSAVE="N" D UP

 S II=II+1,@DATA@(II)=$C(31)

 Q

 ;

ERR ;

 D ^%ZTER

 NEW Y,ERRDTM

 S Y=$$NOW^XLFDT() X ^DD("DD") S ERRDTM=Y

 S BMXSEC="Recording that an error occurred at "_ERRDTM

 I $D(II),$D(DATA) S II=II+1,@DATA@(II)=$C(31)

 Q

 ;

UP ;

 S II=II+1,@DATA@(II)=SOURCE_U_TYPE_U_VALUE_U_ABLE_U_NOSAVE_U_$G(CFLAG)_U_$G(CLEAR)_U_HELP_$C(30)

 Q

 ;

HDR ;

 S HDR="T00008SOURCE^T00001CODE_TYPE^T01024PARMS^T00001ABLE_FLAG^T00001NOSAVE^T00001CLEAR_FLAG^T00100CLEAR_FIELDS^T00200HELP_TEXT"

 Q

 ;

EMP(DATA,DFN,STATUS) ; EP -- AGG PAT EMPL STATUS TRIGGER

 NEW UID,II,VALUE,SOURCE,IEN,HELP,TYPE,ABLE,AGGEMSTS,PREVSTS,FLAG,AGGPTEPL

 S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)

 S DATA=$NA(^TMP("AGGTREMP",UID))

 K @DATA

 S II=0

 NEW $ESTACK,$ETRAP S $ETRAP="D ERR^AGGWTRIG D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2

 D HDR

 S @DATA@(II)=HDR_$C(30)

 S FLAG=0

 S PREVSTS=$$GET1^DIQ(9000001,DFN_",",.21,"I")

 I $G(STATUS)'="",$G(PREVSTS)'=STATUS S FLAG=1

 S AGGEMSTS=STATUS

 S AGGPTEPL=$$GET1^DIQ(9000001,DFN_",",.19,"I") D

 . I 'FLAG S CLEAR="" Q

 . I AGGEMSTS'=3&(AGGEMSTS'=5)&(AGGEMSTS'=9)&(PREVSTS'=3)&(PREVSTS'=5)&(PREVSTS'=9) S CLEAR="" Q

 . S CLEAR="AGGPTEPL"

 I PREVSTS="" S CLEAR="AGGPTEPL"

 I AGGEMSTS'=3&(AGGEMSTS'=5)&(AGGEMSTS'=9) S SOURCE="AGGPTEPL",ABLE="Y",VALUE=AGGPTEPL,TYPE="T",HELP="",NOSAVE="N" D UP

 E  S SOURCE="AGGPTEPL",ABLE="N",TYPE="T",HELP="",CLEAR="",NOSAVE="N" D

 . I AGGEMSTS=3 S VALUE=$O(^AUTNEMPL("B","UNEMPLOYED","")) D

 .. I VALUE="" S ABLE="Y" Q

 .. I VALUE'="" S VALUE=VALUE_$C(28)_"UNEMPLOYED"

 . I AGGEMSTS=5 S VALUE=$O(^AUTNEMPL("B","RETIRED","")) D

 .. I VALUE="" S ABLE="Y" Q

 .. I VALUE'="" S VALUE=VALUE_$C(28)_"RETIRED"

 . I AGGEMSTS=9 S VALUE=$O(^AUTNEMPL("B","UNKNOWN","")) D

 .. I VALUE="" S ABLE="Y" Q

 .. I VALUE'="" S VALUE=VALUE_$C(28)_"UNKNOWN"

 . D UP

 S II=II+1,@DATA@(II)=$C(31)

 Q

 ;

SSN(DATA,SSN,NOSSN) ; EP -- AGG PAT SSN TRIGGER

 NEW UID,II,VALUE,SOURCE,IEN,HELP,TYPE,ABLE,AUPN,AUPIDS

 S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)

 S DATA=$NA(^TMP("AGGTRSSN",UID))

 K @DATA

 S II=0

 NEW $ESTACK,$ETRAP S $ETRAP="D ERR^AGGWTRIG D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2

 D HDR

 S @DATA@(II)=HDR_$C(30)

 ;

 I $G(SSN)="",$G(NOSSN)="" D

 . S SOURCE="AGGNOSSN",ABLE="Y",TYPE="T",HELP="",CLEAR="",NOSAVE="N",VALUE="" D UP

 . S SOURCE="AGGPTSSN",ABLE="Y",TYPE="X",HELP="",CLEAR="",NOSAVE="N",VALUE="" D UP

 I $G(SSN)'="",$G(NOSSN)="" D

 . S SOURCE="AGGNOSSN",ABLE="N",TYPE="T",HELP="",CLEAR="AGGNOSSN",NOSAVE="N",VALUE="" D UP

 I $G(SSN)="",$G(NOSSN)'="" D

 . S SOURCE="AGGNOSSN",ABLE="Y",TYPE="T",HELP="",CLEAR="",NOSAVE="N",VALUE="" D UP

 . S SOURCE="AGGPTSSN",ABLE="N",TYPE="X",HELP="",CLEAR="",NOSAVE="N",VALUE="" D UP

 S II=II+1,@DATA@(II)=$C(31)

 Q

AGGPTTRG  ;VNGT/HS/ALA-Patient Detail Triggers ; 27 May 2010  4:25 PM

 +1       ;;1.0;PATIENT REGISTRATION GUI;;Nov 15, 2010

 +2       ;

 +3       ;

INIT(DATA,DFN) ;EP -- AGG PERSONAL DETAIL TRIGGER

 +1       ; Input

 +2       ;   DFN      - Patient IEN

 +3       ;

 +4        NEW UID,II,VALUE,SOURCE,IEN,HELP,TYPE,ABLE,NOSAVE,AGGPTSSV,DOBE,SSNV

 +5        SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)

 +6        SET DATA=$NAME(^TMP("AGGTRPAT",UID))

 +7        KILL @DATA

 +8        SET II=0

 +9       ; SAC 2006 2.2.3.3.2

           NEW $ESTACK,$ETRAP

           SET $ETRAP="D ERR^AGGWTRIG D UNWIND^%ZTER"

 +10       DO HDR

 +11       SET @DATA@(II)=HDR_$CHAR(30)

 +12      ;

 +13       SET DOBE=$PIECE($GET(^AGFAC(DUZ(2),0)),U,13)

           SET SSNV=$PIECE(^AUPNPAT(DFN,0),U,23)

 +14       FOR SOURCE="AGGPTLNM","AGGPTFNM","AGGPTMNM","AGGPTSFX"

               SET ABLE="N"

               SET VALUE=""

               SET TYPE="X"

               SET HELP=""

               SET CLEAR=""

               SET NOSAVE="N"

               DO UP

 +15       IF $DATA(^XUSEC("AGZMGR",DUZ))

               Begin DoDot:1

 +16               SET SOURCE="AGGPTHRN"

                   SET ABLE="Y"

                   SET VALUE=""

                   SET TYPE="X"

                   SET HELP=""

                   SET CLEAR=""

                   SET NOSAVE="N"

                   DO UP

 +17               IF SSNV'=""

                       IF "XV"[$PIECE(^AUTTSSN(SSNV,0),U)

                           Begin DoDot:2

 +18                           SET SOURCE="AGGPTDOB"

                               SET ABLE="Y"

                               SET VALUE=""

                               SET TYPE="D"

                               SET HELP="The NAME/SSN/DOB have been Verified by the SSA do not change the DOB unless you are certain that it is incorrect!"

                               DO UP

                           End DoDot:2

                           QUIT 

 +19               SET SOURCE="AGGPTDOB"

                   SET ABLE="Y"

                   SET VALUE=""

                   SET TYPE="X"

                   SET HELP=""

                   SET CLEAR=""

                   SET NOSAVE="N"

                   DO UP

               End DoDot:1

 +20       IF '$DATA(^XUSEC("AGZMGR",DUZ))

               Begin DoDot:1

 +21               SET SOURCE="AGGPTHRN"

                   SET ABLE="N"

                   SET VALUE=""

                   SET TYPE="X"

                   SET HELP=""

                   SET CLEAR=""

                   SET NOSAVE="N"

                   DO UP

 +22               IF SSNV'=""

                       IF "XV"[$PIECE(^AUTTSSN(SSNV,0),U)

                           Begin DoDot:2

 +23                           IF DOBE="Y"

                                   SET SOURCE="AGGPTDOB"

                                   SET ABLE="N"

                                   SET VALUE=""

                                   SET TYPE="D"

                                   SET HELP="DOB must be edited by a supervisor."

                                   DO UP

 +24                           IF DOBE="N"

                                   SET SOURCE="AGGPTDOB"

                                   SET ABLE="Y"

                                   SET VALUE=""

                                   SET TYPE="D"

                                   SET HELP="The NAME/SSN/DOB have been Verified by the SSA do not change the DOB unless you are certain that it is incorrect!"

                                   DO UP

                           End DoDot:2

                           QUIT 

 +25               IF DOBE="Y"

                       SET SOURCE="AGGPTDOB"

                       SET ABLE="N"

                       SET VALUE=""

                       SET TYPE="X"

                       SET HELP="DOB must be edited by a supervisor."

                       SET CLEAR=""

                       SET NOSAVE="N"

                       DO UP

 +26               IF DOBE="N"

                       SET SOURCE="AGGPTDOB"

                       SET ABLE="Y"

                       SET VALUE=""

                       SET TYPE="X"

                       SET HELP=""

                       SET CLEAR=""

                       SET NOSAVE="N"

                       DO UP

               End DoDot:1

 +27      ;

 +28       SET AGGPTSSV=$$GET1^DIQ(9000001,DFN_",",.23,"E")

 +29       SET AGGNOSSN=$$GET1^DIQ(9000001,DFN_",",.24,"E")

 +30       SET AGGPTSSN=$$GET1^DIQ(2,DFN_",",.09,"E")

 +31       SET SSN=$$GET1^DIQ(2,DFN_",",.09,"E")

 +32      ;

 +33       IF AGGPTSSN'=""

               IF AGGNOSSN=""

                   Begin DoDot:1

 +34                   SET SOURCE="AGGNOSSN"

                       SET ABLE="N"

                       SET VALUE=""

                       SET TYPE="X"

                       SET HELP=""

                       SET CLEAR=""

                       SET NOSAVE="N"

                       DO UP

 +35                   IF AGGPTSSV="P"!(AGGPTSSV="")

                           SET SOURCE="AGGPTSSN"

                           SET ABLE="Y"

                           SET VALUE=""

                           SET TYPE="X"

                           SET HELP=""

                           SET CLEAR=""

                           SET NOSAVE="N"

                           DO UP

 +36                   IF AGGPTSSV'="P"

                           IF AGGPTSSV'=""

                               SET SOURCE="AGGPTSSN"

                               SET ABLE="N"

                               SET VALUE=""

                               SET TYPE="X"

                               SET HELP=""

                               SET CLEAR=""

                               SET NOSAVE="Y"

                               DO UP

                   End DoDot:1

 +37       IF AGGPTSSN=""

               IF AGGNOSSN'=""

                   Begin DoDot:1

 +38                   SET SOURCE="AGGNOSSN"

                       SET ABLE="Y"

                       SET VALUE=""

                       SET TYPE="X"

                       SET HELP=""

                       SET CLEAR=""

                       SET NOSAVE="N"

                       DO UP

 +39                   SET SOURCE="AGGPTSSN"

                       SET ABLE="N"

                       SET VALUE=""

                       SET TYPE="X"

                       SET HELP=""

                       SET CLEAR=""

                       SET NOSAVE="Y"

                       DO UP

                   End DoDot:1

 +40       IF AGGPTSSN=""

               IF AGGNOSSN=""

                   Begin DoDot:1

 +41                   SET SOURCE="AGGNOSSN"

                       SET ABLE="Y"

                       SET VALUE=""

                       SET TYPE="X"

                       SET HELP=""

                       SET CLEAR=""

                       SET NOSAVE="N"

                       DO UP

 +42                   SET SOURCE="AGGPTSSN"

                       SET ABLE="N"

                       SET VALUE=""

                       SET TYPE="X"

                       SET HELP=""

                       SET CLEAR=""

                       SET NOSAVE="N"

                       DO UP

                   End DoDot:1

 +43      ;

 +44       SET HRN=$$HRN^AGGUL1(DFN)

 +45       IF $EXTRACT(HRN,1,1)="T"

               IF $DATA(^XUSEC("AGZMGR",DUZ))

                   SET SOURCE="AGGPTHRN"

                   SET ABLE="Y"

                   SET VALUE=""

                   SET TYPE="X"

                   SET HELP=""

                   SET CLEAR=""

                   SET NOSAVE="N"

                   DO UP

 +46       SET II=II+1

           SET @DATA@(II)=$CHAR(31)

 +47       QUIT 

 +48      ;

ERR       ;

 +1        DO ^%ZTER

 +2        NEW Y,ERRDTM

 +3        SET Y=$$NOW^XLFDT()

           XECUTE ^DD("DD")

           SET ERRDTM=Y

 +4        SET BMXSEC="Recording that an error occurred at "_ERRDTM

 +5        IF $DATA(II)

               IF $DATA(DATA)

                   SET II=II+1

                   SET @DATA@(II)=$CHAR(31)

 +6        QUIT 

 +7       ;

UP        ;

 +1        SET II=II+1

           SET @DATA@(II)=SOURCE_U_TYPE_U_VALUE_U_ABLE_U_NOSAVE_U_$GET(CFLAG)_U_$GET(CLEAR)_U_HELP_$CHAR(30)

 +2        QUIT 

 +3       ;

HDR       ;

 +1        SET HDR="T00008SOURCE^T00001CODE_TYPE^T01024PARMS^T00001ABLE_FLAG^T00001NOSAVE^T00001CLEAR_FLAG^T00100CLEAR_FIELDS^T00200HELP_TEXT"

 +2        QUIT 

 +3       ;

EMP(DATA,DFN,STATUS) ; EP -- AGG PAT EMPL STATUS TRIGGER

 +1        NEW UID,II,VALUE,SOURCE,IEN,HELP,TYPE,ABLE,AGGEMSTS,PREVSTS,FLAG,AGGPTEPL

 +2        SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)

 +3        SET DATA=$NAME(^TMP("AGGTREMP",UID))

 +4        KILL @DATA

 +5        SET II=0

 +6       ; SAC 2006 2.2.3.3.2

           NEW $ESTACK,$ETRAP

           SET $ETRAP="D ERR^AGGWTRIG D UNWIND^%ZTER"

 +7        DO HDR

 +8        SET @DATA@(II)=HDR_$CHAR(30)

 +9        SET FLAG=0

 +10       SET PREVSTS=$$GET1^DIQ(9000001,DFN_",",.21,"I")

 +11       IF $GET(STATUS)'=""

               IF $GET(PREVSTS)'=STATUS

                   SET FLAG=1

 +12       SET AGGEMSTS=STATUS

 +13       SET AGGPTEPL=$$GET1^DIQ(9000001,DFN_",",.19,"I")

           Begin DoDot:1

 +14           IF 'FLAG

                   SET CLEAR=""

                   QUIT 

 +15           IF AGGEMSTS'=3&(AGGEMSTS'=5)&(AGGEMSTS'=9)&(PREVSTS'=3)&(PREVSTS'=5)&(PREVSTS'=9)

                   SET CLEAR=""

                   QUIT 

 +16           SET CLEAR="AGGPTEPL"

           End DoDot:1

 +17       IF PREVSTS=""

               SET CLEAR="AGGPTEPL"

 +18       IF AGGEMSTS'=3&(AGGEMSTS'=5)&(AGGEMSTS'=9)

               SET SOURCE="AGGPTEPL"

               SET ABLE="Y"

               SET VALUE=AGGPTEPL

               SET TYPE="T"

               SET HELP=""

               SET NOSAVE="N"

               DO UP

 +19      IF '$TEST

               SET SOURCE="AGGPTEPL"

               SET ABLE="N"

               SET TYPE="T"

               SET HELP=""

               SET CLEAR=""

               SET NOSAVE="N"

               Begin DoDot:1

 +20               IF AGGEMSTS=3

                       SET VALUE=$ORDER(^AUTNEMPL("B","UNEMPLOYED",""))

                       Begin DoDot:2

 +21                       IF VALUE=""

                               SET ABLE="Y"

                               QUIT 

 +22                       IF VALUE'=""

                               SET VALUE=VALUE_$CHAR(28)_"UNEMPLOYED"

                       End DoDot:2

 +23               IF AGGEMSTS=5

                       SET VALUE=$ORDER(^AUTNEMPL("B","RETIRED",""))

                       Begin DoDot:2

 +24                       IF VALUE=""

                               SET ABLE="Y"

                               QUIT 

 +25                       IF VALUE'=""

                               SET VALUE=VALUE_$CHAR(28)_"RETIRED"

                       End DoDot:2

 +26               IF AGGEMSTS=9

                       SET VALUE=$ORDER(^AUTNEMPL("B","UNKNOWN",""))

                       Begin DoDot:2

 +27                       IF VALUE=""

                               SET ABLE="Y"

                               QUIT 

 +28                       IF VALUE'=""

                               SET VALUE=VALUE_$CHAR(28)_"UNKNOWN"

                       End DoDot:2

 +29               DO UP

               End DoDot:1

 +30       SET II=II+1

           SET @DATA@(II)=$CHAR(31)

 +31       QUIT 

 +32      ;

SSN(DATA,SSN,NOSSN) ; EP -- AGG PAT SSN TRIGGER

 +1        NEW UID,II,VALUE,SOURCE,IEN,HELP,TYPE,ABLE,AUPN,AUPIDS

 +2        SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)

 +3        SET DATA=$NAME(^TMP("AGGTRSSN",UID))

 +4        KILL @DATA

 +5        SET II=0

 +6       ; SAC 2006 2.2.3.3.2

           NEW $ESTACK,$ETRAP

           SET $ETRAP="D ERR^AGGWTRIG D UNWIND^%ZTER"

 +7        DO HDR

 +8        SET @DATA@(II)=HDR_$CHAR(30)

 +9       ;

 +10       IF $GET(SSN)=""

               IF $GET(NOSSN)=""

                   Begin DoDot:1

 +11                   SET SOURCE="AGGNOSSN"

                       SET ABLE="Y"

                       SET TYPE="T"

                       SET HELP=""

                       SET CLEAR=""

                       SET NOSAVE="N"

                       SET VALUE=""

                       DO UP

 +12                   SET SOURCE="AGGPTSSN"

                       SET ABLE="Y"

                       SET TYPE="X"

                       SET HELP=""

                       SET CLEAR=""

                       SET NOSAVE="N"

                       SET VALUE=""

                       DO UP

                   End DoDot:1

 +13       IF $GET(SSN)'=""

               IF $GET(NOSSN)=""

                   Begin DoDot:1

 +14                   SET SOURCE="AGGNOSSN"

                       SET ABLE="N"

                       SET TYPE="T"

                       SET HELP=""

                       SET CLEAR="AGGNOSSN"

                       SET NOSAVE="N"

                       SET VALUE=""

                       DO UP

                   End DoDot:1

 +15       IF $GET(SSN)=""

               IF $GET(NOSSN)'=""

                   Begin DoDot:1

 +16                   SET SOURCE="AGGNOSSN"

                       SET ABLE="Y"

                       SET TYPE="T"

                       SET HELP=""

                       SET CLEAR=""

                       SET NOSAVE="N"

                       SET VALUE=""

                       DO UP

 +17                   SET SOURCE="AGGPTSSN"

                       SET ABLE="N"

                       SET TYPE="X"

                       SET HELP=""

                       SET CLEAR=""

                       SET NOSAVE="N"

                       SET VALUE=""

                       DO UP

                   End DoDot:1

 +18       SET II=II+1

           SET @DATA@(II)=$CHAR(31)

 +19       QUIT