Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: AGED6PD

AGED6PD.m

Go to the documentation of this file. 
  1. AGED6PD ;IHS/ASDS/TPF - EDIT/DISPLAY RAILROAD PHARMACY PAGE ;    
  1.  ;;7.1;PATIENT REGISTRATION;**1,2,11**;AUG 25, 2005;Build 1
  1.  ;IHS/OIT/NKD AG*7.1*11 MU2 UNKNOWN SEX
  1.  ;
  1. EN(COMPIEN) ;EP - CALLED BY AGED6
  1.  ;
  1.  S ID0=$P(COMPIEN,",")
  1.  S ID1=$P(COMPIEN,",",3)
  1.  S AG("PG")="4RRED"
  1.  S ROUTID=$P($T(+1)," ")
  1.  S CALLER="SCREEN"
  1. VAR ;
  1.  I $G(EXIT) K EXIT Q
  1.  D DRAW
  1.  I $D(AGSEENLY) K DIR S DIR(0)="E",DIR("A")="Enter Response" D ^DIR Q
  1.  W !,AGLINE("EQ")
  1.  K DIR
  1.  I $D(^XUSEC("AGZMGR",DUZ)) D
  1.  .S DIR("A")="ENTER ACTION (<E>dit a field,<D>elete eligibility date:"
  1.  .S DIR(0)="SAO^E:EDIT;D:DELETE"
  1.  E  S DIR("A")="ENTER ACTION <E>dit a field:",DIR(0)="SAO^E:EDIT"
  1.  D ^DIR
  1.  Q:Y=$G(AGOPT("ESCAPE"))
  1.  I '$D(AGSEENLY) I $D(MYERRS("C","E")),(Y'?1N.N),(Y'="E"),(Y'="V"),(Y'="A"),(Y'="D") W !,"ERRORS ON THIS PAGE. PLEASE EDIT BEFORE EXITING!!" H 3 G VAR
  1.  I Y="" D CLEAN(ID0) Q
  1.  Q:$D(DTOUT)!$D(DUOUT)!$D(DIROUT)
  1.  I Y="E" D EDIT G VAR
  1.  I Y="D" D EDIT G VAR
  1.  W !,"COMMAND "_Y_" UNKNOWN!" H 3
  1.  G VAR
  1. EDIT ;EP
  1.  K DIR
  1.  S DIR("A")="CHANGE which item? (1-"_$G(AG("N"))_") NONE// "
  1.  S DIR(0)="LO^1:"_$G(AG("N"))
  1.  D ^DIR
  1.  I Y=$G(AGOPT("ESCAPE")) S EXIT=1 Q
  1.  S CHOICES=Y
  1.  I '$D(AGSEENLY) I ($D(MYERRS("C","E"))&(Y'?1N.N)),(Y'["V"),(Y'=$G(AGOPT("ESCAPE"))) W !,"ERRORS ON THIS PAGE. PLEASE FIX BEFORE EXITING!!" H 3 Q
  1.  Q:Y=$G(AGOPT("ESCAPE"))
  1.  Q:$D(DLOUT)!(Y["N")!$D(DUOUT)
  1.  Q:$D(DFOUT)!$D(DTOUT)
  1.  I $D(DQOUT)!(+Y<1)!(+Y>AG("N")) W !!,"You must enter a number from 1 to ",AG("N") H 2 Q
  1.  S AGY=Y
  1.  F AGI=1:1 S AG("SEL")=+$P(AGY,"|",AGI) Q:AG("SEL")<1!(AG("SEL")>AG("N"))  D
  1.  .I AG("SEL")>12 D EDITPOLM^AGEDPRVI(.POLMEMBS,CHOICES) Q
  1.  .D @($P(AG("C"),"|",AG("SEL")))
  1.  ;AFTER EDITING THE SELECTION MUST BE UPDATED SO ANY ERRORS CORRECTED WILL BE REFLECTED ON THE REDRAWN SCREEN
  1.  S COMPIEN=ID0_",11,"_ID1_","_0
  1.  ;S AGSELECT=$$UPDTSEL^AGUTILS("FINDPVT",.AGINS,COMPIEN)
  1.  S AGSELECT=$$UPDTSEL^AGUTILS(.AGINS,COMPIEN,$P(AGSELECT,U,2))  ;AG*7.1*1 IM18549 ERROR IN ERROR MSG UPDATE  
  1.  D UPDATE1^AGED(DUZ(2),ID0,3,"")
  1.  K AGI,AGY
  1.  Q
  1. CLEAN(ID0) ;EP - CLEAN EMPTY RECORD. IF NO PRIVATE INSURER HAS BEEN ENTERED,
  1.  ;THE RECORD IS MEANINGLESS
  1.  I '$O(^AUPNPRVT(ID0,11,0)) D CLEANZER(ID0)
  1.  Q
  1. CLEANZER(ID0) ;EP - CLEAN ZERO NODE WITH NO INFOR
  1.  K DIK,DA
  1.  S DIK="^AUPNPRVT(",DA=ID0 D ^DIK
  1.  Q
  1. END ;EP - CLEAN UP THE VARS
  1.  K AG,DLOUT,DTOUT,DFOUT,DQOUT,DA,DIC,DR,AGSCRN,Y
  1.  K ADA,WDA,ADT,WDT,REC,NEWENTRY,POLPTR,ID0,ID1,CALLER
  1.  Q
  1. DRAW ;EP - MAIN SCREEN DRAW
  1.  D HDR
  1.  D GETAW
  1.  Q
  1. HDR ;
  1.  S AGPAT=$P($G(^DPT(ID0,0)),U)
  1.  S AGCHRT=$S($D(^AUPNPAT(ID0,41,DUZ(2),0)):$P($G(^AUPNPAT(ID0,41,DUZ(2),0)),U,2),1:"xxxxx")
  1.  S AG("AUPN")=""
  1.  S:$D(^AUPNPAT(ID0,0)) AG("AUPN")=^(0)
  1.  S AGLINE("-")=$TR($J(" ",78)," ","-")
  1.  S AGLINE("EQ")=$TR($J(" ",78)," ","=")
  1.  S $P(AGLINE("PGLN"),"=",81)=""
  1.  W $$S^AGVDF("IOF"),!
  1.  S ROUTID=$P($T(+1)," ")
  1.  S SUBS=$P($G(AGSELECT),U,11)
  1.  D PROGVIEW^AGUTILS(DUZ,SUBS)
  1.  W "IHS REGISTRATION ",$S($D(AGSEENLY):"VIEW SCREEN",1:"EDITOR")
  1.  W ?36,"Railroad Pharmacy"
  1.  W ?80-$L($P($G(^DIC(4,DUZ(2),0)),U)),$P($G(^DIC(4,DUZ(2),0)),U)
  1.  S AGLINE("-")=$TR($J(" ",80)," ","-")
  1.  S AGLINE("EQ")=$TR($J(" ",80)," ","=")
  1.  W !,AGLINE("EQ")
  1.  W !,$E(AGPAT,1,23)
  1.  W ?23,$$DTEST^AGUTILS(ID0)
  1.  I $D(AGCHRT) W ?42,"HRN#:",AGCHRT
  1.  ;GET ELIG STAT
  1.  S AGELSTS=$P($G(^AUPNPAT(DFN,11)),U,12)
  1.  W ?56,"(",$S(AGELSTS="C":"CHS & DIRECT",AGELSTS="I":"INELIGIBLE",AGELSTS="D":"DIRECT ONLY",AGELSTS="P":"PENDING VERIFICATION",1:"NONE"),")"
  1.  W !,AGLINE("EQ")
  1.  ;K AG("EDIT")  AG:*7.1*2 TO ALLOW QUIT FROM AG6 WHEN EDITING PATIENT RATHER THAN ADDING A PATIENT
  1.  Q
  1. GETAW ;EP - DISPLAY THE SCREEN
  1.  K AG("C")
  1.  F AG=1:1 D  Q:$G(AGSCRN)[("*END*")
  1.  . S AGSCRN=$P($T(@1+AG),";;",2,15)
  1.  . Q:AGSCRN[("*END*")
  1.  . S CAPTION=$P(AGSCRN,U)  ;FLD CAP
  1.  . I $E(CAPTION)="-" W !,CAPTION Q  ;- DENOTES SECTION
  1.  . S DIC=$P(AGSCRN,U,3)    ;FILE OR SUBFILE #
  1.  . S DR=$P(AGSCRN,U,4)      ;FLD #
  1.  . S NEWLINE=$P(AGSCRN,U,5)  ;NEWLINE OR INDENT
  1.  . S CAPDENT=$P(AGSCRN,U,2)   ;CAP INDENT
  1.  . S ITEMNUM=$P(AGSCRN,U,6)   ;ITEM #
  1.  . S TAGCALL=$TR($P($P(AGSCRN,U,7),"|",1),"~",U)   ;TAG TO CALL TO EDIT THIS FLD
  1.  . S EXECUTE=$P(AGSCRN,"|",2)      ;USE TO DISP FLD WHICH IS DEPENDENT ON ANOTHER FLD
  1.  . S PREEXEC=$P(AGSCRN,"|",3)     ;PLACE CODE TO BE XECUTED PRIOR TO DISP OF THE FLD
  1.  . S PRECAPEX=$P(AGSCRN,"|",4)   ;PLACE CODE TO EXECUTE BEF CAP/FLD LBL
  1.  . S POSTEXEC=$P(AGSCRN,"|",5)    ;PLACE ANYTHING HERE TO BE EXECUTED AFT DISP OF THE FLD
  1.  . S:TAGCALL'="" $P(AG("C"),"|",ITEMNUM)=TAGCALL   ;SELECTION STRING
  1.  . W @NEWLINE
  1.  . W ITEMNUM
  1.  . W $S(ITEMNUM'="":") ",1:"")
  1.  . I PRECAPEX="" W @CAPDENT,$S($G(CAPTION)'="":CAPTION_": ",$G(CAPTION)="":"",1:$P($G(^DD(DIC,DR,0)),U)_": ")
  1.  . I PRECAPEX'="" X PRECAPEX I $T W @CAPDENT,$S($G(CAPTION)'="":CAPTION_": ",$G(CAPTION)="":"",1:$P($G(^DD(DIC,DR,0)),U)_": ")
  1.  .;IF EDITING DISP DATA
  1.  .;E DISP ONLY THE CAPS
  1.  .I 'NEWENTRY D
  1.  .. S D0=ID0
  1.  .. I DIC'["." S D0=D0_","
  1.  .. E  S D0=ID1_","_D0_","
  1.  .. S FLAG=""
  1.  .. I DIC=9999999.18 S D0=$G(AGINSPTR) I DR=.21 S FLAG="I"
  1.  .. ;LOOP TO HANDLE MULTIPLE DR'S FOR ONE CAP
  1.  .. N PIECE
  1.  .. S VDR=DR
  1.  .. F PIECE=1:1 S DR=$P(VDR,";",PIECE) Q:DR=""  D
  1.  ... I $P(PREEXEC,";",PIECE)'="" X $P(PREEXEC,";",PIECE)
  1.  ... I $P(EXECUTE,";",PIECE)="" D
  1.  .... I DIC=9999999.18,(DR=.01) S PLANPTR=$P($G(^AUPNRRE(ID0,11,ID1,0)),U,4)
  1.  .... I DIC=9999999.18 S D0=$G(PLANPTR)
  1.  .... I DIC=9000005.11,(DR=.05) S COVPTR=$P($G(^AUPNRRE(ID0,11,ID1,0)),U,11),GRPPTR=$P($G(^AUPNRRE(ID0,11,ID1,0)),U,11)
  1.  .... I DIC=9000005.11,(DR=.04) S AGELP("INS")=$$GET1^DIQ(DIC,D0,DR,FLAG)
  1.  .... S DIC("S")="I $D(AGELP(""INS"")),$P(^(0),U,2)=AGELP(""INS"")"
  1.  .... I DIC=9999999.77 S D0=$G(GRPPTR)
  1.  .... I DIC=9999999.6519 D  Q:DT1=""
  1.  ..... S D0=$G(COVPTR),DT1=$O(^AUTTPIC(37,19,"B",DT+.01),-1) Q:DT1=""
  1.  ..... S DT1=$O(^AUTTPIC(37,19,"B",DT1,""))
  1.  ..... S D0=DT1_","_D0_","
  1.  .... I DIC=9000005.11,(DR=.01) D GETDATES(ID0) Q   ;DISPLAY DATES AFTER STANDARD REG. SORT
  1.  .... I DIC=9999999.6519,((DR=.23)!(DR=.24)!(DR=.25)) W $J($$GET1^DIQ(DIC,D0,DR,FLAG),10,2)
  1.  .... E  W $$GET1^DIQ(DIC,D0,DR,FLAG)
  1.  ... I $P(EXECUTE,";",PIECE)'="" S D0=$TR(D0,",") X $P(EXECUTE,";",PIECE)
  1.  ... I $P(POSTEXEC,";",PIECE)'="" X $P(POSTEXEC,";",PIECE)
  1.  ..K PIECE,VDR
  1.  S AG("N")=$L(AG("C"),"|")
  1.  W !,$G(AGLINE("-"))
  1.  K MYERRS,MYVARS
  1.  D FETCHERR^AGEDERR(AG("PG"),.MYERRS)
  1.  S MYVARS("DFN")=ID0,MYVARS("FINDCALL")="FINDPVT"
  1.  S MYVARS("SELECTION")=$G(AGSELECT),MYVARS("SITE")=DUZ(2)
  1.  I '$G(NEWENTRY) D EDITCHEK^AGEDERR(.MYERRS,.MYVARS,1)
  1.  D VERIF^AGUTILS
  1.  Q
  1. GETDATES(ID0) ;EP - GET THE DTS USING LIST^DIC
  1.  K RESULT,ERROR
  1.  S FLAGS=""
  1.  S FIELDS=";.01I;.02I;.03I"
  1.  D LIST^DIC(9000005.11,","_ID0_",",FIELDS,FLAGS,"*",,,,,,"RESULT","ERROR")
  1.  D DATESORT(.RESULT)
  1.  Q
  1. DATESORT(RESULT) ;EP - TAKE LIST RETURNED BY FILE^DIC AND SORT IT
  1.  ;BASED ON SPECS
  1.  N DATESORT,SPECSUB,EFFDT,ENDDT,CVG
  1.  S REC=0
  1.  F  S REC=$O(RESULT("DILIST","ID",REC)) Q:'REC  D
  1.  .S ENDDT=RESULT("DILIST","ID",REC,.02)
  1.  .S EFFDT=RESULT("DILIST","ID",REC,.01)
  1.  .S CVG=RESULT("DILIST","ID",REC,.03)
  1.  .Q:CVG'="D"
  1.  .S SPECSUB=$S(ENDDT="":"O",1:"T")  ;O=OPEN ENDED, T=TERM DATE
  1.  .I SPECSUB="O" S DATESORT(SPECSUB,EFFDT)=ENDDT_U_CVG
  1.  .E  S DATESORT(SPECSUB,-ENDDT)=EFFDT_U_CVG
  1.  S DEFEDDT=$O(DATESORT("O",""))  ;GET DEFAULT EDIT DT. FIRST ONE IN DISP
  1.  I DEFEDDT="" S DEFEDDT=$O(DATESORT("T","")) S:DEFEDDT'="" DEFEDDT=$P(DATESORT("T",DEFEDDT),U)
  1.  D SHOWNEW(.DATESORT)
  1.  Q
  1. SHOWNEW(DATESORT) ;EP
  1.  N SPECSUB,DATE,DATE1,CVG,EFFDT,ENDDT,REC
  1.  S SPECSUB=""
  1.  S REC=1
  1.  I '$D(DATESORT("O")) F  S SPECSUB=$O(DATESORT(SPECSUB)) Q:SPECSUB=""  D ALLTERM Q
  1.  F  S SPECSUB=$O(DATESORT(SPECSUB)) Q:SPECSUB=""  D
  1.  .S DATE=""
  1.  .F  S DATE=$O(DATESORT(SPECSUB,DATE)) Q:DATE=""  D
  1.  ..S DATE1=$P(DATESORT(SPECSUB,DATE),U)
  1.  ..S CVG=$P(DATESORT(SPECSUB,DATE),U,2)
  1.  ..I SPECSUB="O" S EFFDT=DATE,ENDDT=""
  1.  ..E  S EFFDT=DATE1,ENDDT=-DATE
  1.  ..I REC'=1 W !
  1.  ..S Y=EFFDT X ^DD("DD")
  1.  ..W ?3,Y
  1.  ..;W ?57,CVG
  1.  ..S Y=ENDDT X ^DD("DD")
  1.  ..W ?40,Y
  1.  ..W ?79,$S($$ISACTIVE^AGINS(EFFDT,ENDDT):"A",1:"I")
  1.  ..I $$ISACTIVE^AGINS(EFFDT,ENDDT) S DEFEDDT=EFFDT
  1.  ..S REC=REC+1
  1.  Q
  1. ALLTERM ;EP
  1.  S DATE=""
  1.  F  S DATE=$O(DATESORT(SPECSUB,DATE),-1) Q:DATE=""  D
  1.  .S DATE1=$P(DATESORT(SPECSUB,DATE),U)
  1.  .S CVG=$P(DATESORT(SPECSUB,DATE),U,2)
  1.  .I SPECSUB="O" S EFFDT=DATE,ENDDT=""
  1.  .E  S EFFDT=DATE1,ENDDT=-DATE
  1.  .I REC'=1 W !
  1.  .S Y=EFFDT X ^DD("DD")
  1.  .W ?3,Y
  1.  .;W ?57,CVG
  1.  .S Y=ENDDT X ^DD("DD")
  1.  .W ?40,Y
  1.  .W ?79,$S($$ISACTIVE^AGINS(EFFDT,ENDDT):"A",1:"I")
  1.  .I $$ISACTIVE^AGINS(EFFDT,ENDDT) S DEFEDDT=EFFDT
  1.  .S REC=REC+1
  1.  Q
  1. WMSG ;EP - DISP THIS MSG IF THIS IS A NEW ENTRY
  1.  W !,"Editing Pharmacy Railroad Part D Eligibility record"
  1.  Q
  1.  ;;;;;;;;;;;;;;;;;;;;;;;;;;
  1.  ; EDIT RAILROAD PART D FLDS
  1.  ;;;;;;;;;;;;;;;;;;;;;;;;;;
  1. EDITNAME(ID0,ID1) ;EP - EDIT MEDICARE NAME
  1.  K DIE,DIC,DA,DR
  1.  S DA(1)=ID0
  1.  S DA=ID1
  1.  S DIE="^AUPNRRE("_DA(1)_",11,"
  1.  S DR=".05R"
  1.  D ^DIE
  1.  K DIE,DIC,DA,DR
  1.  Q
  1. EDITGEN(ID0,ID1) ;EP - EDIT GENDER
  1.  K DIE,DIC,DA,DR
  1.  S DA(1)=ID0
  1.  S DA=ID1
  1.  S DIE="^AUPNRRE("_DA(1)_",11,"
  1.  S DR=".08R"
  1.  D ^DIE
  1.  K DIE,DIC,DA,DR
  1.  Q
  1. EDITID(ID0,ID1) ;EP - EDIT ID NUmber
  1.  K DIE,DIC,DA,DR
  1.  S DA(1)=ID0
  1.  S DA=ID1
  1.  S DIE="^AUPNRRE("_DA(1)_",11,"
  1.  S DR=".06R"
  1.  D ^DIE
  1.  K DIE,DIC,DA,DR
  1.  Q
  1. EDITDOB(ID0,ID1) ;EP - EDIT DOB
  1.  K DIE,DIC,DA,DR
  1.  S DA(1)=ID0
  1.  S DA=ID1
  1.  S DIE="^AUPNRRE("_DA(1)_",11,"
  1.  S DR=".09R"
  1.  D ^DIE
  1.  K DIE,DIC,DA,DR
  1.  Q
  1. EDITPC(ID0,ID1) ;EP - EDIT PERSON CODE
  1.  K DIE,DIC,DA,DR
  1.  S DA(1)=ID0
  1.  S DA=ID1
  1.  S DIE="^AUPNRRE("_DA(1)_",11,"
  1.  S DR=.07
  1.  D ^DIE
  1.  K DIE,DIC,DA,DR
  1.  Q
  1. EDITCOV(ID0,ID1) ;EP - EDIT  COVERAGE TYPE PTR
  1.  K DIE,DIC,DA,DR
  1.  S DA(1)=ID0
  1.  S DA=ID1
  1.  S DIE="^AUPNRRE("_DA(1)_",11,"
  1.  S DR=.12
  1.  D ^DIE
  1.  K DIE,DIC,DA,DR
  1.  Q
  1. ADDEFF(ID0) ;EP - ADD/EDIT NEW EFFECTIVE DATE
  1.  K DIE,DIC,DA,DR
  1.  I $G(DEFEDDT)'="" S DIC("B")=DEFEDDT   ;IF DEFAULT USE IT
  1.  S DA(1)=ID0
  1.  S DIC(0)="AE"
  1.  S DIC="^AUPNRRE("_DA(1)_",11,"
  1.  S DIC("S")="I $P($G(^(0)),U,3)=""D"""
  1.  D ^DIC
  1.  I +Y<0 Q
  1.  K DIE,DIC,DA,DR
  1.  D EFFDT(ID0,+Y)
  1.  Q
  1. EFFDT(ID0,ID1) ;EP - EDIT EFFECTIVE DATE
  1.  K DIE,DIC,DA,DR,DIDEL,ONLYONE,IEN
  1.  I $D(^XUSEC("AGZMGR",DUZ)) S DIDEL=9000005.11
  1.  S IEN=0 F ONLYONE=1:1 S IEN=$O(^AUPNRRE(ID0,11,IEN)) Q:'IEN
  1.  S DA=ID1
  1.  S DA(1)=ID0
  1.  S DIE="^AUPNRRE("_DA(1)_",11,"
  1.  I ONLYONE=1 D
  1.  .W !!,"THERE IS ONLY ONE ELGIBILITY DATE RECORD FOR THIS PHARMACY ELIGIBILITY"
  1.  .W !,"IF YOU DELETE THIS DATE THE ENTIRE PHARMACY DATA WILL BE DELETED FOR THIS"
  1.  .W !,"PATIENT"
  1.  .W !
  1.  .S DR=".01R"
  1.  .S DR(2,9000005.11)=".01R"
  1.  E  S DR=".01",DR(2,9000005.11)=".01"
  1.  D ^DIE
  1.  Q:'$D(DA)  ;IF NO DA, ENTRY WAS DELETED
  1.  K DIE,DIC,DA,DR
  1.  I $D(^AUPNRRE(ID0,11,ID1,0)) D EDITEXP(ID0,ID1)
  1.  E  S EXIT=1
  1.  Q
  1. EDITEXP(ID0,ID1) ;EP - EDIT EXPIRATION DATE
  1.  K DIE,DIC,DA,DR
  1.  S DA(1)=ID0
  1.  S DA=ID1
  1.  S DIE="^AUPNRRE("_DA(1)_",11,"
  1.  S DR=.02
  1.  D ^DIE
  1.  K DIE,DIC,DA,DR
  1.  Q
  1. EDITGRP(ID0,ID1) ;EP - EDIT GROUP NAME
  1.  K DIE,DIC,DA,DR
  1.  S DA(1)=ID0
  1.  S DA=ID1
  1.  S DIE="^AUPNRRE("_DA(1)_",11,"
  1.  S DR=.11
  1.  D ^DIE
  1.  K DIE,DIC,DA,DR
  1.  Q
  1. EDITPLAN(ID0,ID1) ;EP - EDIT PLAN
  1.  K DIE,DIC,DA,DR
  1.  S DA(1)=ID0
  1.  S DA=ID1
  1.  S DIE="^AUPNRRE("_DA(1)_",11,"
  1.  S DR=".04R"
  1.  D ^DIE
  1.  K DIE,DIC,DA,DR
  1.  Q
  1. EDITSTBN(COVPTR) ;EP - EDIT START BENEFIT
  1.  K DIE,DIC,DA,DR
  1.  W !,"SPECIFICATIONS NOT YET PROVIDED!" H 3
  1.  K DIE,DIC,DA,DR
  1.  Q
  1. EDITDED(COVPTR) ;EP - EDIT DEDUCTIBLE
  1.  K DIE,DIC,DA,DR
  1.  W !,"SPECIFICATIONS NOT YET PROVIDED!" H 3
  1.  K DIE,DIC,DA,DR
  1.  Q
  1. EDITCOP(COVPTR) ;EP - EDIT CO-PAY
  1.  K DIE,DIC,DA,DR
  1.  W !,"SPECIFICATIONS NOT YET PROVIDED!" H 3
  1.  K DIE,DIC,DA,DR
  1.  Q
  1.  ;FIELD EDITS
  1.  ; ****************************************************************
  1.  ; ON LINES BELOW:
  1.  ; U "^" DELIMITED
  1.  ; AGSCRN CONTAINS THE $TEXT OF EACH LINE BELOW STARTING AT TAG '1'
  1.  ; PIECE  VAR       DESC
  1.  ; -----  --------  -----------------------------------------------
  1.  ; 1      CAPTION    FLD CAP ASSIGNED BY PROGRAMMER OVERRIDES FLD LBL IF POPULATED
  1.  ; 2      CAPDENT    POSITION ON LINE TO DISP CAP
  1.  ; 3      DIC        FILE OR SUBFILE #
  1.  ; 4      DR         FLD # - THESE CAN BE SEPARATED BY ";" THIS ALLOWS
  1.  ;                   MULTIPLE FLDS TO BE PRINTED WITH THE SAME CAP AS IN
  1.  ;                   'CITY,STATE,ZIP'
  1.  ; 5      NEWLINE    NEW LINE OR NOT (MUST BE EITHER A '!' OR '?#') USE THIS TO INDENT THE LINE
  1.  ; 6      ITEMNUM    ITEM # ASSIGNMENT. USE THIS TO ASSIGN THE ITEM # USED TO CHOOSE THIS
  1.  ;                   FLD ON THE SCREEN
  1.  ; 7      TAGCALL    TAG TO CALL WHEN THIS FLD IS CHOSEN BY USER TO BE EDITED
  1.  ;
  1.  ; BAR "|" DELIMITED
  1.  ; PIECE  VAR        DESC
  1.  ; -----  --------   ----------------------------------------------
  1.  ; 2      EXECUTE    EXECUTE CODE TO GET FLD THAT ANOTHER IS POINTING TO.
  1.  ;                   EXECUTED AFT FLD PRINT. IF MUTLIPLE FLDS ARE PRINTED
  1.  ;                   THEN MULTIPLE EXECUTE CODES CAN BE SEPARATED BY ";".
  1.  ; 3      PREEXEC    EXECUTE CODE TO DO BEF FLD PRINTS. USE TO SCREEN OUT
  1.  ;                   PRINTING A FLD VALUE. FOR MULTIPLES SEPARATE BY ";"
  1.  ; 4      PRECAPEX   EXECUTE CODE TO DO BEF PRINTING THE CAP OR FLD LBL.
  1.  ;                   USE TO SCREEN OUT PRINTING A CAP/FLD LBL
  1.  ; 5      POSTEXEC   EXECUTE CODE TO DO AFT PRINTING THE FLD DATA
  1.  ;                   FOR MULTIPLES SEPARATE BY ";"
  1.  ;
  1.  ;FIELDS BELOW DELETED PER ADRIAN 12/13/05
  1.  ;Coverage Type^?3^9000005.11^.12^?49^^^||||
  1.  ;Co-Pay.......^?3^9999999.6519^.25^?44^11^EDITCOP(COVPTR)||||
  1.  ;Deductible...^?3^9999999.6519^.24^?44^10^EDITDED(COVPTR)^||||
  1.  ;Begin Date...^?3^9999999.6519^.01^?49^^||||
  1.  ;Start Benefit^?3^9999999.6519^.23^?44^9^EDITSTBN(COVPTR)^||||
  1.  ;Ins. Type^?3^9999999.18^.21^?23^^^||||
  1. 1 ;
  1.  ;;------------------RAILROAD PART D DATA-----------------------------------------
  1.  ;;Medicare Name^?3^9000005.11^.05^!^1^EDITNAME(ID0,ID1)^||||W ?49,$C(124)
  1.  ;;Gender^?3^9000005.11^.08^?49^4^EDITGEN(ID0,ID1)^||||
  1.  ;;ID Number^?3^9000005.11^.06^!^2^EDITID(ID0,ID1)^||||W ?49,$C(124)
  1.  ;;Date of Birth^?3^9000005.11^.09^?49^5^EDITDOB(ID0,ID1)^||||
  1.  ;;Person Code^?3^9000005.11^.07^!^3^EDITPC(ID0,ID1)^||||
  1.  ;;-ELIGIBILITY DATES--------------------------------------------------------------
  1.  ;;-----Effective Date-----------------------Expire Date---------------------------
  1.  ;;^?3^9000005.11^.01^!^6^ADDEFF(ID0)^||||
  1.  ;;--------------------------------------------------------------------------------
  1.  ;;Grp Name^?3^9000005.11^.11^!^7^EDITGRP(ID0,ID1)^||||
  1.  ;;Grp Number^?3^9999999.77^.02^?45^^^||||
  1.  ;;--------------------------------------------------------------------------------
  1.  ;;^?3^9999999.18^.01^!^8^EDITPLAN(ID0,ID1)^||||
  1.  ;;^?3^9999999.18^.02^!^^^||||
  1.  ;;^?3^9999999.18^.03^!^^||||W ","
  1.  ;;^?3^9999999.18^.04^?0^^||||W "  "
  1.  ;;^?3^9999999.18^.05^?0^^||||
  1.  ;;^?3^9999999.18^.06^!^^||||
  1.  ;;*END*