Routine: AGGPTNAM

AGGPTNAM ;VNGT/HS/ALA-Patient Names ; 29 Jun 2010  3:27 PM

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

ALIAS(DATA,DFN,PROC,RIEN,PARMS) ;EP -- AGG UPDATE ALIASES

 NEW UID,II,BQ,PDATA,NAME,PFIEN,FIELD,EXEC,AGGDATA,AGGDATAI,PTYP,VALUE,CHIEN,AGI,AGWP

 NEW X,Y,RESULT,DA,AGIEN,DIC,DLAYGO,IENS,ERROR,AGGPTALS

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

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

 K @DATA

 S II=0

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

 S @DATA@(II)="I00010RESULT^T01024ERROR^I00010RIEN"_$C(30)

 S AGIEN=$O(^AGG(9009068.3,"B","Aliases",""))

 ;if deleting an Alias

 I $G(PROC)="D" D  G DNE

 . NEW DIK,DA

 . S DA(1)=DFN,DA=RIEN

 . S DIK="^DPT("_DA(1)_",.01," D ^DIK

 ;if adding a new Alias

 D PARS

 I $G(PROC)="A" D

 . I $G(RIEN)="" D

 .. I $G(^DPT(DFN,.01,0))="" S ^DPT(DFN,.01,0)="^2.01A^^"

 .. S DA(1)=DFN

 .. S DLAYGO=2.01,DIC(0)="L",DIC="^DPT("_DA(1)_",.01,",X=AGGPTALS

 .. K DO,DD D FILE^DICN S RIEN=+Y

 ;if editing a Legal Name

 S DA(1)=DFN,DA=RIEN,IENS=$$IENS^DILF(.DA)

 F BQ=1:1:$L(PARMS,$C(28)) D  Q:$G(BMXSEC)'=""

 . S PDATA=$P(PARMS,$C(28),BQ) Q:PDATA=""

 . S NAME=$P(PDATA,"=",1)

 . S PFIEN=$O(^AGG(9009068.3,AGIEN,10,"AC",NAME,""))

 . I PFIEN="" S BMXSEC=NAME_" not a valid parameter for this update" Q

 . S FIELD=$P($G(^AGG(9009068.3,AGIEN,10,PFIEN,3)),U,1)

 . S EXEC=$G(^AGG(9009068.3,AGIEN,10,PFIEN,7))

 . I EXEC'="" X EXEC Q

 . I FIELD="" Q

 . S AGGDATA(2.01,IENS,FIELD)=@NAME

 S AGGDATAI(9000001,DFN_",",.03)=DT,AGGDATAI(9000001,DFN_",",.12)=DUZ

 I $D(AGGDATA) D FILE^DIE("","AGGDATA","ERROR")

 I $D(AGGDATAI) D FILE^DIE("I","AGGDATAI","ERROR")

DNE ;

 S RESULT=1_U_U_RIEN

 I $D(ERROR) S RESULT="-1"_U_$G(ERROR("DIERR",1,"TEXT",1))_U_U

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

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

 I $P(RESULT,U,1)=1 D EDIT^AGGEXPRT(DFN)

 S NAME=""

 F  S NAME=$O(^AGG(9009068.3,AGIEN,10,"AC",NAME)) Q:NAME=""  I $G(@NAME)'="" K @NAME

LEGL(DATA,DFN,PROC,RIEN,PARMS) ;EP -- AGG UPDATE LEGAL NAMES

 NEW UID,II,BQ,PDATA,NAME,PFIEN,FIELD,EXEC,AGGDATA,AGGDATAI,PTYP,VALUE,CHIEN,AGI,AGWP

 NEW X,Y,RESULT,DA,AGIEN,DIC,DLAYGO,IENS,ERROR,AGGLNDTC

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

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

 K @DATA

 S II=0

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

 S @DATA@(II)="I00010RESULT^T01024ERROR^I00010RIEN"_$C(30)

 S AGIEN=$O(^AGG(9009068.3,"B","Legal Names",""))

 ;if deleting a Legal Name

 I $G(PROC)="D" D  G DONE

 . NEW DIK,DA

 . S DIK="^AUPNNAMC(",DA=RIEN D ^DIK

 ;if adding a new Legal Name

 D PARS

 I $G(PROC)="A" D

 . I $G(RIEN)="" D

 .. I $G(AGGLNDTC)="" S AGGLNDTC=DT

 .. S DLAYGO=9000033,DIC(0)="L",DIC="^AUPNNAMC(",X=AGGLNDTC

 .. D ^DIC S RIEN=+Y

 ;if editing a Legal Name

 S DA=RIEN,IENS=$$IENS^DILF(.DA)

 S AGGDATAI(9000033,IENS,.02)=DFN

 S AGGDATAI(9000033,IENS,.06)=DUZ

 S AGGDATAI(9000001,DFN_",",.03)=DT,AGGDATAI(9000001,DFN_",",.12)=DUZ

 F BQ=1:1:$L(PARMS,$C(28)) D  Q:$G(BMXSEC)'=""

 . S PDATA=$P(PARMS,$C(28),BQ) Q:PDATA=""

 . S NAME=$P(PDATA,"=",1)

 . S PFIEN=$O(^AGG(9009068.3,AGIEN,10,"AC",NAME,""))

 . I PFIEN="" S BMXSEC=NAME_" not a valid parameter for this update" Q

 . S FIELD=$P($G(^AGG(9009068.3,AGIEN,10,PFIEN,3)),U,1)

 . S EXEC=$G(^AGG(9009068.3,AGIEN,10,PFIEN,7))

 . I EXEC'="" X EXEC Q

 . I FIELD="" Q

 . S AGGDATA(9000033,IENS,FIELD)=@NAME

 I $D(AGGDATA) D FILE^DIE("","AGGDATA","ERROR")

 I $D(AGGDATAI) D FILE^DIE("I","AGGDATAI","ERROR")

DONE ;

 S RESULT=1_U_U_RIEN

 I $D(ERROR) S RESULT="-1"_U_$G(ERROR("DIERR",1,"TEXT",1))_U_U

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

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

 I $P(RESULT,U,1)=1 D EDIT^AGGEXPRT(DFN)

 S NAME=""

 F  S NAME=$O(^AGG(9009068.3,AGIEN,10,"AC",NAME)) Q:NAME=""  I $G(@NAME)'="" K @NAME

PARS ;

 F BQ=1:1:$L(PARMS,$C(28)) D  Q:$G(BMXSEC)'=""

 . S PDATA=$P(PARMS,$C(28),BQ) Q:PDATA=""

 . S NAME=$P(PDATA,"=",1),VALUE=$P(PDATA,"=",2,99)

 . S PFIEN=$O(^AGG(9009068.3,AGIEN,10,"AC",NAME,""))

 . I PFIEN="" S BMXSEC=NAME_" not a valid parameter for this update" Q

 . S PTYP=$P($G(^AGG(9009068.3,AGIEN,10,PFIEN,1)),U,1)

 . I PTYP="D" S VALUE=$$DATE^AGGUL1(VALUE)

 . I PTYP="C" D

 .. I VALUE="" Q

 .. S CHIEN=$O(^AGG(9009068.3,AGIEN,10,PFIEN,5,"B",VALUE,"")) I CHIEN="" Q

 .. S VALUE=$P(^AGG(9009068.3,AGIEN,10,PFIEN,5,CHIEN,0),U,2)

 . I PTYP="W" D  Q

 .. F AGI=1:1  S AGJ=$P(VALUE,$C(10),AGI) Q:AGJ=""  D

 ... S AGWP(AGI,0)=$$CTRL^AGGUL1(AGJ)

 . S @NAME=VALUE

LINIT(DATA,PROC) ;EP -- AGG LEGAL NAME INIT TRIG

 ; Input

 ;   PROC - Transaction type

 NEW UID,II,VALUE,SOURCE,IEN,HELP,TYPE,ABLE,AGGECREL

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

 S DATA=$NA(^TMP("AGGLNMTR",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(PROC)="A" D

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

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

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

NMUP(DATA,AGGLNMC) ; EP -- AGG NAME CHANGE TRIG

 NEW UID,II,VALUE,SOURCE,IEN,HELP,TYPE,ABLE,AGGECREL

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

 S DATA=$NA(^TMP("AGGLNMCTR",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(AGGLNMC)'="" D

 . S SOURCE="AGGLNPRF",VALUE="",ABLE="Y",TYPE="X",CLEAR="",HELP="" D UP

 . S SOURCE="AGGLGDOC",VALUE="",ABLE="Y",TYPE="X",CLEAR="",HELP="" D UP

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

UP ;

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

HDR ;

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

AGGPTNAM  ;VNGT/HS/ALA-Patient Names ; 29 Jun 2010  3:27 PM

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

 +2       ;

ALIAS(DATA,DFN,PROC,RIEN,PARMS) ;EP -- AGG UPDATE ALIASES

 +1        NEW UID,II,BQ,PDATA,NAME,PFIEN,FIELD,EXEC,AGGDATA,AGGDATAI,PTYP,VALUE,CHIEN,AGI,AGWP

 +2        NEW X,Y,RESULT,DA,AGIEN,DIC,DLAYGO,IENS,ERROR,AGGPTALS

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

 +4        SET DATA=$NAME(^TMP("AGGPTALIAS",UID))

 +5        KILL @DATA

 +6       ;

 +7        SET II=0

 +8       ; SAC 2006 2.2.3.3.2

           NEW $ESTACK,$ETRAP

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

 +9        SET @DATA@(II)="I00010RESULT^T01024ERROR^I00010RIEN"_$CHAR(30)

 +10       SET AGIEN=$ORDER(^AGG(9009068.3,"B","Aliases",""))

 +11      ;if deleting an Alias

 +12       IF $GET(PROC)="D"

               Begin DoDot:1

 +13               NEW DIK,DA

 +14               SET DA(1)=DFN

                   SET DA=RIEN

 +15               SET DIK="^DPT("_DA(1)_",.01,"

                   DO ^DIK

               End DoDot:1

               GOTO DNE

 +16      ;if adding a new Alias

 +17       DO PARS

 +18       IF $GET(PROC)="A"

               Begin DoDot:1

 +19               IF $GET(RIEN)=""

                       Begin DoDot:2

 +20                       IF $GET(^DPT(DFN,.01,0))=""

                               SET ^DPT(DFN,.01,0)="^2.01A^^"

 +21                       SET DA(1)=DFN

 +22                       SET DLAYGO=2.01

                           SET DIC(0)="L"

                           SET DIC="^DPT("_DA(1)_",.01,"

                           SET X=AGGPTALS

 +23                       KILL DO,DD

                           DO FILE^DICN

                           SET RIEN=+Y

                       End DoDot:2

               End DoDot:1

 +24      ;if editing a Legal Name

 +25       SET DA(1)=DFN

           SET DA=RIEN

           SET IENS=$$IENS^DILF(.DA)

 +26      ;

 +27       FOR BQ=1:1:$LENGTH(PARMS,$CHAR(28))

               Begin DoDot:1

 +28               SET PDATA=$PIECE(PARMS,$CHAR(28),BQ)

                   IF PDATA=""

                       QUIT

 +29               SET NAME=$PIECE(PDATA,"=",1)

 +30               SET PFIEN=$ORDER(^AGG(9009068.3,AGIEN,10,"AC",NAME,""))

 +31               IF PFIEN=""

                       SET BMXSEC=NAME_" not a valid parameter for this update"

                       QUIT

 +32               SET FIELD=$PIECE($GET(^AGG(9009068.3,AGIEN,10,PFIEN,3)),U,1)

 +33               SET EXEC=$GET(^AGG(9009068.3,AGIEN,10,PFIEN,7))

 +34               IF EXEC'=""

                       XECUTE EXEC

                       QUIT

 +35               IF FIELD=""

                       QUIT

 +36               SET AGGDATA(2.01,IENS,FIELD)=@NAME

               End DoDot:1

               IF $GET(BMXSEC)'=""

                   QUIT

 +37      ;

 +38       SET AGGDATAI(9000001,DFN_",",.03)=DT

           SET AGGDATAI(9000001,DFN_",",.12)=DUZ

 +39       IF $DATA(AGGDATA)

               DO FILE^DIE("","AGGDATA","ERROR")

 +40       IF $DATA(AGGDATAI)

               DO FILE^DIE("I","AGGDATAI","ERROR")

 +41      ;

DNE       ;

 +1        SET RESULT=1_U_U_RIEN

 +2        IF $DATA(ERROR)

               SET RESULT="-1"_U_$GET(ERROR("DIERR",1,"TEXT",1))_U_U

 +3        SET II=II+1

           SET @DATA@(II)=RESULT_$CHAR(30)

 +4        SET II=II+1

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

 +5       ;

 +6        IF $PIECE(RESULT,U,1)=1

               DO EDIT^AGGEXPRT(DFN)

 +7        SET NAME=""

 +8        FOR

               SET NAME=$ORDER(^AGG(9009068.3,AGIEN,10,"AC",NAME))

               IF NAME=""

                   QUIT

               IF $GET(@NAME)'=""

                   KILL @NAME

 +9        QUIT

 +10      ;

LEGL(DATA,DFN,PROC,RIEN,PARMS) ;EP -- AGG UPDATE LEGAL NAMES

 +1        NEW UID,II,BQ,PDATA,NAME,PFIEN,FIELD,EXEC,AGGDATA,AGGDATAI,PTYP,VALUE,CHIEN,AGI,AGWP

 +2        NEW X,Y,RESULT,DA,AGIEN,DIC,DLAYGO,IENS,ERROR,AGGLNDTC

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

 +4        SET DATA=$NAME(^TMP("AGGPTNAM",UID))

 +5        KILL @DATA

 +6       ;

 +7        SET II=0

 +8       ; SAC 2006 2.2.3.3.2

           NEW $ESTACK,$ETRAP

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

 +9        SET @DATA@(II)="I00010RESULT^T01024ERROR^I00010RIEN"_$CHAR(30)

 +10       SET AGIEN=$ORDER(^AGG(9009068.3,"B","Legal Names",""))

 +11      ;

 +12      ;if deleting a Legal Name

 +13       IF $GET(PROC)="D"

               Begin DoDot:1

 +14               NEW DIK,DA

 +15               SET DIK="^AUPNNAMC("

                   SET DA=RIEN

                   DO ^DIK

               End DoDot:1

               GOTO DONE

 +16      ;if adding a new Legal Name

 +17       DO PARS

 +18       IF $GET(PROC)="A"

               Begin DoDot:1

 +19               IF $GET(RIEN)=""

                       Begin DoDot:2

 +20                       IF $GET(AGGLNDTC)=""

                               SET AGGLNDTC=DT

 +21                       SET DLAYGO=9000033

                           SET DIC(0)="L"

                           SET DIC="^AUPNNAMC("

                           SET X=AGGLNDTC

 +22                       DO ^DIC

                           SET RIEN=+Y

                       End DoDot:2

               End DoDot:1

 +23      ;if editing a Legal Name

 +24       SET DA=RIEN

           SET IENS=$$IENS^DILF(.DA)

 +25      ;

 +26       SET AGGDATAI(9000033,IENS,.02)=DFN

 +27       SET AGGDATAI(9000033,IENS,.06)=DUZ

 +28       SET AGGDATAI(9000001,DFN_",",.03)=DT

           SET AGGDATAI(9000001,DFN_",",.12)=DUZ

 +29      ;

 +30       FOR BQ=1:1:$LENGTH(PARMS,$CHAR(28))

               Begin DoDot:1

 +31               SET PDATA=$PIECE(PARMS,$CHAR(28),BQ)

                   IF PDATA=""

                       QUIT

 +32               SET NAME=$PIECE(PDATA,"=",1)

 +33               SET PFIEN=$ORDER(^AGG(9009068.3,AGIEN,10,"AC",NAME,""))

 +34               IF PFIEN=""

                       SET BMXSEC=NAME_" not a valid parameter for this update"

                       QUIT

 +35               SET FIELD=$PIECE($GET(^AGG(9009068.3,AGIEN,10,PFIEN,3)),U,1)

 +36               SET EXEC=$GET(^AGG(9009068.3,AGIEN,10,PFIEN,7))

 +37               IF EXEC'=""

                       XECUTE EXEC

                       QUIT

 +38               IF FIELD=""

                       QUIT

 +39               SET AGGDATA(9000033,IENS,FIELD)=@NAME

               End DoDot:1

               IF $GET(BMXSEC)'=""

                   QUIT

 +40       IF $DATA(AGGDATA)

               DO FILE^DIE("","AGGDATA","ERROR")

 +41       IF $DATA(AGGDATAI)

               DO FILE^DIE("I","AGGDATAI","ERROR")

 +42      ;

DONE      ;

 +1        SET RESULT=1_U_U_RIEN

 +2        IF $DATA(ERROR)

               SET RESULT="-1"_U_$GET(ERROR("DIERR",1,"TEXT",1))_U_U

 +3        SET II=II+1

           SET @DATA@(II)=RESULT_$CHAR(30)

 +4        SET II=II+1

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

 +5       ;

 +6        IF $PIECE(RESULT,U,1)=1

               DO EDIT^AGGEXPRT(DFN)

 +7        SET NAME=""

 +8        FOR

               SET NAME=$ORDER(^AGG(9009068.3,AGIEN,10,"AC",NAME))

               IF NAME=""

                   QUIT

               IF $GET(@NAME)'=""

                   KILL @NAME

 +9        QUIT

 +10      ;

PARS      ;

 +1        FOR BQ=1:1:$LENGTH(PARMS,$CHAR(28))

               Begin DoDot:1

 +2                SET PDATA=$PIECE(PARMS,$CHAR(28),BQ)

                   IF PDATA=""

                       QUIT

 +3                SET NAME=$PIECE(PDATA,"=",1)

                   SET VALUE=$PIECE(PDATA,"=",2,99)

 +4                SET PFIEN=$ORDER(^AGG(9009068.3,AGIEN,10,"AC",NAME,""))

 +5                IF PFIEN=""

                       SET BMXSEC=NAME_" not a valid parameter for this update"

                       QUIT

 +6                SET PTYP=$PIECE($GET(^AGG(9009068.3,AGIEN,10,PFIEN,1)),U,1)

 +7                IF PTYP="D"

                       SET VALUE=$$DATE^AGGUL1(VALUE)

 +8                IF PTYP="C"

                       Begin DoDot:2

 +9                        IF VALUE=""

                               QUIT

 +10                       SET CHIEN=$ORDER(^AGG(9009068.3,AGIEN,10,PFIEN,5,"B",VALUE,""))

                           IF CHIEN=""

                               QUIT

 +11                       SET VALUE=$PIECE(^AGG(9009068.3,AGIEN,10,PFIEN,5,CHIEN,0),U,2)

                       End DoDot:2

 +12               IF PTYP="W"

                       Begin DoDot:2

 +13                       FOR AGI=1:1

                               SET AGJ=$PIECE(VALUE,$CHAR(10),AGI)

                               IF AGJ=""

                                   QUIT

                               Begin DoDot:3

 +14                               SET AGWP(AGI,0)=$$CTRL^AGGUL1(AGJ)

                               End DoDot:3

                       End DoDot:2

                       QUIT

 +15               SET @NAME=VALUE

               End DoDot:1

               IF $GET(BMXSEC)'=""

                   QUIT

 +16       QUIT

 +17      ;

LINIT(DATA,PROC) ;EP -- AGG LEGAL NAME INIT TRIG

 +1       ; Input

 +2       ;   PROC - Transaction type

 +3       ;

 +4        NEW UID,II,VALUE,SOURCE,IEN,HELP,TYPE,ABLE,AGGECREL

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

 +6        SET DATA=$NAME(^TMP("AGGLNMTR",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       IF $GET(PROC)="A"

               Begin DoDot:1

 +13               SET SOURCE="AGGLNPRF"

                   SET VALUE=""

                   SET ABLE="N"

                   SET TYPE="X"

                   SET CLEAR=""

                   SET HELP=""

                   DO UP

 +14               SET SOURCE="AGGLGDOC"

                   SET VALUE=""

                   SET ABLE="N"

                   SET TYPE="X"

                   SET CLEAR=""

                   SET HELP=""

                   DO UP

               End DoDot:1

 +15      ;

 +16       SET II=II+1

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

 +17       QUIT

 +18      ;

NMUP(DATA,AGGLNMC) ; EP -- AGG NAME CHANGE TRIG

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

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

 +3        SET DATA=$NAME(^TMP("AGGLNMCTR",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        IF $GET(AGGLNMC)'=""

               Begin DoDot:1

 +10               SET SOURCE="AGGLNPRF"

                   SET VALUE=""

                   SET ABLE="Y"

                   SET TYPE="X"

                   SET CLEAR=""

                   SET HELP=""

                   DO UP

 +11               SET SOURCE="AGGLGDOC"

                   SET VALUE=""

                   SET ABLE="Y"

                   SET TYPE="X"

                   SET CLEAR=""

                   SET HELP=""

                   DO UP

               End DoDot:1

 +12      ;

 +13       SET II=II+1

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

 +14       QUIT

 +15      ;

UP        ;

 +1        SET II=II+1

           SET @DATA@(II)=SOURCE_U_TYPE_U_VALUE_U_ABLE_U_$GET(CLEAR)_U_HELP_$CHAR(30)

 +2        QUIT

 +3       ;

HDR       ;

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

 +2        QUIT

AGGPTNAM.m