AGEDGUAR ; IHS/ASDS/TPF - EDIT/DISP GUARANTOR SCREEN ;
;;7.1;PATIENT REGISTRATION;**1,2**;JAN 31, 2007
;
EN(GD0,GD1,GD2,NEWENTRY,AGSELECT,ALLFLDRQ) ;EP -
;ALLFLDRQ = TRUE IF THE PAT IS NON-INDIAN
I $G(ALLFLDRQ)="" S ALLFLDRQ=$$ISNONIND^AGUTILS(DFN)
I $G(AGSELECT)'="" S NONPER=$P(AGSELECT,U,14)'[("AUPNPAT")
K GUARDEL
S EXIT=0
I NEWENTRY D I EXIT W !,"Entry not made." H 2 D CLEANZER(GD0),END Q
.S SAME=0
.D DRAW,WMSG
.D NEWENTRY Q:EXIT
.D NEWGUAR Q:EXIT
.D:'SAME EDITDOB
.D EDITPO
.D:'SAME EDITSEX
.D NEWEFFDT Q:EXIT
.D:'SAME EDITDEP
.S COMPIEN=GD0_","_GD1_","_GD2
.;S AGSELECT=$$UPDTSEL^AGUTILS("FINDGUAR",.AGINS,COMPIEN)
.S AGSELECT=$$UPDTSEL^AGUTILS(.AGINS,COMPIEN,GD0_",0)") ;AG*7.1*1 IM18549
.S NEWENTRY=0
S COMPIEN=GD0_","_GD1_","_GD2
VAR D DRAW
I $D(AGSEENLY) K DIR S DIR("A")="Press Return...",DIR(0)="FO" D ^DIR Q
W !,AGLINE("EQ")
K DIR
S DIR("A")="ENTER ACTION (<E>dit"_$S($D(^XUSEC("AGZMGR",DUZ)):", <A>dd to the insurer file):",1:")")
S DIR(0)="SAO^"_$S($D(^XUSEC("AGZMGR",DUZ)):"A:ADD;",1:"")_"E:EDIT"
D ^DIR
I Y="",('$O(^AUPNGUAR(GD0,1,GD1,11,0))!(GD2="")) D CLEAN(GD0) D END Q
I $D(MYERRS("C","E")),(Y'?1N.N),(Y'="E"),('ALLFLDRQ) W !,"ERRORS ON THIS PAGE. PLEASE EDIT BEFORE EXITING!!" H 3 G VAR
Q:Y=$G(AGOPT("ESCAPE"))
I ALLFLDRQ,(Y'?1N.N),(Y'="E") I $$ALLFLDRQ(.ENTRYARY) W !,"PATIENT IS NON-INDIAN AND MUST HAVE ALL GUARANTOR DATA ENTERED!!" H 3 G VAR
Q:$D(DTOUT)!$D(DUOUT)!$D(DIROUT)
I Y="A" D ADDINS G VAR
K DIR
S DIR("A")="CHANGE which item? (1-"_AG("N")_") NONE// "
D READ^AGED1
I ($D(MYERRS("C","E"))&(Y'?1N.N)),(Y'["V"),(Y'=AGOPT("ESCAPE")) W !,"ERRORS ON THIS PAGE. PLEASE FIX BEFORE EXITING!!" H 3 G VAR
Q:Y=$G(AGOPT("ESCAPE"))
I (ALLFLDRQ&(Y'?1N.N)),(Y'=AGOPT("ESCAPE")) I $$ALLFLDRQ(.ENTRYARY) W !,"PATIENT IS NON-INDIAN AND MUST HAVE ALL GUARANTOR DATA ENTERED!!" H 3 G VAR
G END:$D(DLOUT)!(Y["N")!$D(DUOUT),VAR:$D(AG("ERR"))
Q:$D(DFOUT)!$D(DTOUT)
I $D(DQOUT)!(+Y<1)!(+Y>AG("N")) W !!,"You must enter a number from 1 to ",AG("N") H 2 G VAR
S AGY=Y
F AGI=1:1 S AG("SEL")=+$P(AGY,",",AGI) Q:AG("SEL")<1!(AG("SEL")>AG("N")) D @($P(AG("C"),",",AG("SEL")))
I $G(GUARDEL) Q ;NO GUAR, RET TO SUMM PG
;S AGSELECT=$$UPDTSEL^AGUTILS("FINDGUAR",.AGINS,COMPIEN)
;S AGSELECT=$$UPDTSEL^AGUTILS(.AGINS,COMPIEN,$P(AGSELECT,U,2)) ;AG*7.1*1 IM18549
S AGSELECT=$$UPDTSEL^AGUTILS(.AGINS,COMPIEN,GD0_",0)") ;AG*7.1*2 ERROR FOUND IN PATCH 2 TESTING
D UPDATE1^AGED(DUZ(2),DFN,3,"")
K AGI,AGY
G VAR
ADDINS ;EP - ADD INSURER TO AUTNINS
D ^AGBAN,^AGTMINS
Q
CLEAN(GD0) ;EP - DEL EMPTY REC
I '$O(^AUPNGUAR(GD0,1,GD1,11,0)) D
.D CLEANZER(GD0)
Q
CLEANZER(GD0) ;EP
K DIK,DA
S DIK="^AUPNGUAR(",DA=GD0 D ^DIK
Q
END K DLOUT,DTOUT,DFOUT,DQOUT,DA,DIC,DR,AGSCRN,Y,ADA,WDA,ADT,WDT,ADFN
K WDFN,REC,NEWENTRY,ROUTID,DEFEDDT,ENTRYARY,DEFEFFDT,GUARDEL,COMPIEN
Q
DRAW ;EP
S AG("PG")="4GUARA"
S ROUTID=$P($T(+1)," ")
D ^AGED
D GETAW
Q
GETAW ;
K DEFEFFDT,DEFDEPEN
K AG("C")
F AG=1:1 D Q:$G(AGSCRN)[("*END*")
. S AGSCRN=$P($T(@1+AG),";;",2,15)
. Q:AGSCRN[("*END*")
. S CAPTION=$P(AGSCRN,U)
. I $E(CAPTION)="-" W !,CAPTION Q
. S DIC=$P(AGSCRN,U,3)
. S DR=$P(AGSCRN,U,4)
. S NEWLINE=$P(AGSCRN,U,5)
. S CAPDENT=$P(AGSCRN,U,2)
. S ITEMNUM=$P(AGSCRN,U,6)
. S TAGCALL=$P($P(AGSCRN,U,7),"|",1)
. S EXECUTE=$P(AGSCRN,"|",2)
. S PREEXEC=$P(AGSCRN,"|",3)
. S PRECAPEX=$P(AGSCRN,"|",4)
. S POSTEXEC=$P(AGSCRN,"|",5)
. S:TAGCALL'="" $P(AG("C"),",",ITEMNUM)=TAGCALL
. W @NEWLINE
. W ITEMNUM
. W $S(ITEMNUM'="":". ",1:"")
. I PRECAPEX="" W @CAPDENT,$S($G(CAPTION)'="":CAPTION_": ",$G(CAPTION)="":"",1:$P($G(^DD(DIC,DR,0)),U)_": ")
. I PRECAPEX'="" X PRECAPEX I $T W @CAPDENT,$S($G(CAPTION)'="":CAPTION_": ",$G(CAPTION)="":"",1:$P($G(^DD(DIC,DR,0)),U)_": ")
.I 'NEWENTRY D
..S FLAG=""
.. S D0=GD0
.. I DIC'["." S D0=D0_","
.. E S D0=GD1_","_D0_","
.. I DIC[("V") D
... S DIC=$$GETVDIC($P($P($G(^AUPNGUAR(GD0,1,GD1,0)),U),";",2))
... S D0=$P($P($G(^AUPNGUAR(GD0,1,GD1,0)),U),";")
... I DIC=9000001,(DR=.02) S DIC=2,DR=".111"
... I DIC=9000001,(DR=".03;.04;.05") S DIC=2,DR=".114;.115;.116"
... I DIC=9000001,(DR=.06) S DIC=2,DR=.131
..;I DIC=9000043.0111 S ITEMNUM=5 S WD0=","_GD1_","_GD0_"," D GETDATES(WD0) Q
..I DIC=9000043.0111 S ITEMNUM=5 S WD0=","_GD1_","_GD0_"," D GETDATES^AGEDGUA1(WD0) Q ;AG*7.1*1 SAC REQUIREMENT ROUTINE TOO LARGE MOVED SUBRTN
.. N PIECE
.. S VDR=DR
.. F PIECE=1:1 S DR=$P(VDR,";",PIECE) Q:DR="" D
... I CAPTION="STREET" S ITEMNUM=AG("N") S ITEMNUM=ITEMNUM+1 W ?0,ITEMNUM_". STREET: " S AG("N")=ITEMNUM,$P(AG("C"),",",ITEMNUM)=TAGCALL
... I DIC=2,(DR=.115) S DR="STATE:ABBREVIATION"
... I DIC'=9000043.0101,(DR=.04) S DR="STATE:ABBREVIATION"
... I $P(PREEXEC,";",PIECE)'="" X $P(PREEXEC,";",PIECE)
... I $P(EXECUTE,";",PIECE)="" S ENTRY=$$GET1^DIQ(DIC,D0,DR,FLAG) W ENTRY S:ITEMNUM'="" ENTRYARY(ITEMNUM)=ENTRY
... I $P(EXECUTE,";",PIECE)'="" S D0=$TR(D0,",") X $P(EXECUTE,";",PIECE)
... I $P(POSTEXEC,";",PIECE)'="" X $P(POSTEXEC,";",PIECE)
..K PIECE,VDR
..I DIC="XXXXXXXXX" D
...S ITEMNUM=AG("N")
...S AG("FLDCNT")=ITEMNUM
...I $D(AG("TMPDEP")) K AG("TMPDEP")
...D FINDDEP
K MYERRS,MYVARS
D FETCHERR^AGEDERR(AG("PG"),.MYERRS)
S MYVARS("DFN")=DFN,MYVARS("FINDCALL")="FINDGUAR",MYVARS("SELECTION")=$G(AGSELECT),MYVARS("SITE")=DUZ(2)
I '$G(NEWENTRY) D EDITCHEK^AGEDERR(.MYERRS,.MYVARS,1)
W !,$G(AGLINE("-"))
D VERIF^AGUTILS
Q
GETVDIC(VROOT) ;EP - PROCESS VAR PTR FLD
Q:VROOT="" ""
S VROOT=U_VROOT_"0)"
Q +$P($G(@VROOT),U,2)
WMSG ;EP - MSG TO DISP IF NO ENTRY IN FILE
W !,"You must first enter a GUARANTOR"
Q
NEWENTRY ;EP - CREATE TOP LEVEL
W !!
K DIC,DIE,DR,DA
S DIC="^AUPNGUAR("
S DIC(0)="L"
S X="`"_DFN
K DD,DO
D ^DIC
I +Y<0 S EXIT=1
S GD0=+Y
;S NEWENTRY=0
Q
NEWGUAR ;
K DIR
S DIR("B")="SAME"
S DIR("A")="Select GUARANTOR"
S DIR(0)="FO^1:30"
D ^DIR
I $D(DTOUT)!$D(DUOUT)!$D(DIROUT) S EXIT=1 Q
S X=Y
S SAME=X="SAME"
I X="SAME" D SAME(DFN) Q
K DIC,DIE,DR,DA,DIR
S TEMPDFN=DFN
S DA(1)=GD0
S DIC("S")="I $G(Y)'=TEMPDFN"
S DIC="^AUPNGUAR("_DA(1)_",1,"
S DIC(0)="MEQL"
K DD,DO
D ^DIC
S DFN=TEMPDFN
;I +Y<0,(X="SAME") D SAME Q
I +Y<0 S EXIT=1 Q
S GD1=+Y
I ALLFLDRQ,(+Y<0) W !,"PATIENT IS NON-INDIAN AND MUST HAVE ALL GUARANTOR DATA ENTERED!!" H 3 G NEWGUAR
S NONPER=$P(Y,U,2)'[("AUPNPAT") ;NOT IN AUPNPAT SO THIS IS NOT A PERSON
;THIS DEPENDS ON WHAT THEY DECIDE TO DO ABOUT ENTERING GURANTORS WHICH ARE NOT
;PATS AND ARE NOT EMPLOYERS OR INSURERS
I ALLFLDRQ,+Y S ENTRYARY(1)=+Y
Q
;IF SAME ENTERED THEN THE GUARANTOR IS THE PATIENT
SAME(X) ;EP
;IF THE USER ENTERS SAME THEN IT IS ASSUMED THE GUARANTOR IS THE SAME AS
;THE PATIENT SO THE LOOKUP WILL ONLY BE ON THE PATIENT FILE
N SAMESEX
S DIC("V")="I +Y(0)=9000001"
S DA(1)=GD0
S DIC="^AUPNGUAR("_DA(1)_",1,"
S DIC(0)="LMEQ"
K DD,DO
S TEMPDFN=X
S X=$P($G(^DPT(X,0)),U)
D ^DIC
I +Y<0 S EXIT=1 Q
S DFN=TEMPDFN
S GD1=+Y
S SAMESEX=$P($G(^DPT(DFN,0)),U,2)
S SAMEDOB=$P($G(^DPT(DFN,0)),U,3)
K DIC,DR,DIE,DA,DD,DO
S DA(1)=GD0
S DA=GD1
S DIE="^AUPNGUAR("_DA(1)_",1,"
S DR=".04///^S X=SAMEDOB;.05///^S X=SAMESEX;.06///^S X=""SELF"""
D ^DIE
Q
NEWEFFDT ;
K DIC,DIE,DR,DA,X
S DA(2)=GD0
S DA(1)=GD1
S DIC="^AUPNGUAR("_DA(2)_",1,"_DA(1)_",11,"
S DIC(0)="ALMEQ"
I $G(AGY)'="" I $D(DEFEFFDT(AGY)) S DIC("B")=$G(DEFEFFDT(AGY))
K DD,DO
D ^DIC
I +Y<0 S EXIT=1 Q
S GD2=+Y
I ALLFLDRQ,(+Y<0) W !,"PATIENT IS NON-INDIAN AND MUST HAVE ALL GUARANTOR DATA ENTERED!!" H 3 G NEWEFFDT
I $P(Y,U,3) D EDITEXP Q
D EDITEFF
Q
EDITGUAR ;GUAR NAME
K DIC,DR,DIE,DA,DD,DO,DIR
S GUARDEL=0
S DA(1)=GD0
S DA=GD1
S DIE="^AUPNGUAR("_DA(1)_",1,"
S DR=.01
I ALLFLDRQ S DR=".01R",DIE("NO^")=""
I DR'[("R") I $$ISREQ^AGFLDREQ(9000043,.01) S DIE("NO^")="",DR=".01R"
D ^DIE
I ALLFLDRQ S ENTRYARY(1)=$G(X)
I '$D(DA) S GUARDEL=1
K DIC,DR,DIE,DA
Q
EDITREF ;REF #
K DIC,DR,DIE,DA,DD,DO
S DA(1)=GD0
S DA=GD1
S DIE="^AUPNGUAR("_DA(1)_",1,"
S DR=.02
I ALLFLDRQ S DR=".02R",DIE("NO^")=""
I DR'[("R") I $$ISREQ^AGFLDREQ(9000043,.02) S DIE("NO^")="",DR=".02R"
D ^DIE
I ALLFLDRQ S ENTRYARY(2)=$G(X)
K DIC,DR,DIE,DA
Q
EDITPO ;PO #
K DIC,DR,DIE,DA,DD,DO
S DA(1)=GD0
S DA=GD1
S DIE="^AUPNGUAR("_DA(1)_",1,"
I ALLFLDRQ S DR=".03R",DIE("NO^")=""
E S DR=.03
D ^DIE
I ALLFLDRQ S ENTRYARY(3)=$G(X)
K DIC,DR,DIE,DA
Q
EDITDOB ;DOB
K DIC,DR,DIE,DA,DD,DO
S DA(1)=GD0
S DA=GD1
S DIE="^AUPNGUAR("_DA(1)_",1,"
S DR=.04
I ALLFLDRQ,('$G(NONPER)) S DR=".04R",DIE("NO^")=""
I DR'[("R") I $$ISREQ^AGFLDREQ(9000043,.04) S DIE("NO^")="",DR=".04R"
D ^DIE
I ALLFLDRQ S ENTRYARY(4)=$G(X)
K DIC,DR,DIE,DA
Q
EDITSEX ;GENDER
K DIC,DR,DIE,DA,DD,DO
S DA(1)=GD0
S DA=GD1
S DIE="^AUPNGUAR("_DA(1)_",1,"
S DR=.05
I ALLFLDRQ,('$G(NONPER)) S DR=".05R",DIE("NO^")=""
I DR'[("R") I $$ISREQ^AGFLDREQ(9000043,.05) S DIE("NO^")="",DR=".05R"
D ^DIE
K DIC,DR,DIE,DA
Q
EDITEFF ;EFF DT
K DIC,DR,DIE,DA,DD,DO
S DA=GD2
S DA(1)=GD1
S DA(2)=GD0
S DIE="^AUPNGUAR("_DA(2)_",1,"_DA(1)_",11,"
I ALLFLDRQ S DR(3,9000043.0111)=".01R",DIE("NO^")=""
E S DR(3,9000043.0111)=".01"
S DR=".01"
D ^DIE
Q:'$D(DA)
K DIC,DR,DIE,DA
D EDITEXP
Q
EDITEXP ;EXP DT
K DIC,DR,DIE,DA,DD,DO
S DA=GD2
S DA(1)=GD1
S DA(2)=GD0
S DIE="^AUPNGUAR("_DA(2)_",1,"_DA(1)_",11,"
S DR=".02"
I ALLFLDRQ S DR(3,9000043.0111)=".02R",DIE("NO^")=""
E S DR(3,9000043.0111)=".02"
D ^DIE
K DIC,DR,DIE,DA
Q
;EDIT ADDRESS OF GUARANTOR
EDITADD ;EP
K DIC,DR,DIE,DA,DD,DO
;IF ALL ADDRESS FIELD ARE MISSING
S ALLOW=$$GUARADD^AGEDERR2($G(AGSELECT))
I 'ALLOW W !,"ADDRESS MUST BE EDITED IN TABLE MAINTENANCE!!" H 2 Q
;WHAT FILE ARE WE LOOKING AT?
S DIE=$P(^AUPNGUAR(GD0,1,GD1,0),U)
S DA=$P(DIE,";")
S DIE=U_$P(DIE,";",2)
S:DIE[("AUPNPAT") DIE="^DPT("
I DIE[("DPT") S DR=".111;.114;.115;.116;.131"
E S DR=".02;.03;.04;.05;.06"
D ^DIE
Q
ALLFLDRQ(ARRAY) ;EP - ARE ALL FLDS ENTERED
N MISSING
S MISSING=0
S ITEM="" F S ITEM=$O(ARRAY(ITEM)) Q:ITEM="" D
.I $G(NONPER),(ITEM=4!(ITEM=5)) S ARRAY(ITEM)="NA"
.I $G(ARRAY(ITEM))="" S MISSING=1
Q MISSING
FINDDEP ;EP - FIND DEPS
S AG("DEP")=0
S AG("GUAR")=$P($G(^AUPNGUAR(GD0,1,GD1,0)),U)
F S AG("DEP")=$O(^AUPNGUAR("C",AG("GUAR"),AG("DEP"))) Q:'AG("DEP") D
. S AG("PREC")=0
. F S AG("PREC")=$O(^AUPNGUAR("C",AG("GUAR"),AG("DEP"),AG("PREC"))) Q:'AG("PREC") D
.. S AG("FLDCNT")=AG("FLDCNT")+1,AG("TMPDEP",AG("FLDCNT"))=AG("DEP")_U_AG("PREC")
.. S DEFDEPEN(AG("FLDCNT"))=AG("DEP")_","_AG("PREC")
.. S $P(AG("C"),",",AG("FLDCNT"))="EDITDEP"
.. W !,AG("FLDCNT"),". ",?4,$P($G(^DPT(AG("DEP"),0)),U)
.. W ?30,$P($G(^AUPNPAT(AG("DEP"),41,DUZ(2),0)),U,2)
.. I $P($G(^AUPNGUAR(AG("DEP"),1,GD1,0)),U,6)'="" D
... W ?47,$P($G(^AUTTRLSH($P($G(^AUPNGUAR(AG("DEP"),1,GD1,0)),U,6),0)),U)
.. W ?67,$$AGE^AUPNPAT(AG("DEP"))
K AG("DEP"),AG("PREC"),AG("GUAR")
I $D(AG("TMPDEP")) S AG("N")=AG("FLDCNT")
Q
EDITDEP ;EP - EDIT RELATIONSHIP FLD OF DEP
K DIC,DR,DIE,DA,DD,DO
S DA(1)=GD0
S DA=GD1
I $G(AGY)'="",$D(DEFDEPEN(AGY)) S DA=$P($G(DEFDEPEN(AGY)),",",2),DA(1)=$P($G(DEFDEPEN(AGY)),",")
S DIE="^AUPNGUAR("_DA(1)_",1,"
S DR=".06"
I ALLFLDRQ,('$G(NONPER)) S DR=".06R",DIE("NO^")=""
I DR'[("R") I $$ISREQ^AGFLDREQ(9000043,.06) S DIE("NO^")="",DR=".06R"
D ^DIE
K DIC,DR,DIE,DA
Q
;
; U "^" DELIMITED
; AGSCRN CONTAINS THE $TEXT OF EACH LINE BELOW STARTING AT TAG '1'
; PIECE VAR DESC
; ----- -------- -----------
; 1 CAPTION FLD CAP ASSIGNED BY PROGRAMMER OVERRIDES FLD LABEL IF POPULATED
; 2 CAPDENT POS ON LINE TO DISP CAP
; 3 DIC FILE OR SUBFILE #
; 4 DR FLD # - THESE CAN BE SEPARATED BY ";" THIS ALLOWS
; MULT FLDS TO BE PRINTED WITH THE SAME CAP AS IN 'CITY,STATE,ZIP'
; 5 NEWLINE NEW LINE OR NOT (MUST BE EITHER A '!' OR '?#') USE THIS TO INDENT THE LINE
; 6 ITEMNUM ITEM # ASSIGNMENT. USE THIS TO ASSIGN THE ITEM # USED TO CHOOSE THIS FLD ON THE SCREEN
; 7 TAGCALL TAG TO CALL WHEN THIS FLD IS CHOSEN BY USER TO EDIT
; BAR "|" DELIMITED
; PIECE VAR DESC
; ----- -------- -----------
; 2 EXECUTE EXECUTE CODE TO GET FLD THAT ANOTHER IS POINTING TO.
; EXECUTED AFT FLD PRINT. IF MULT FLDS ARE PRINTED
; THEN MULT EXECUTE CODES CAN BE SEPARATED BY ";".
; 3 PREEXEC EXECUTE CODE TO DO BEF FLD PRINTS. USE TO SCREEN OUT
; PRINTING A FLD VALUE. FOR MULT SEPARATE BY ";"
; 4 PRECAPEX EXECUTE CODE TO DO BEF PRINTING THE CAP OR FLD LBL.
; USE TO SCREEN OUT PRINTING A CAP/FLD LBL
; 5 POSTEXEC EXECUTE CODE TO DO AFT PRINTING THE FLD DATA FOR MULT SEPARATE BY ";"
;
;AG*7.1*2 CHANGED ;;MOTHER'S NAME^?3^2^.2402^?45^^^|||W $C(124)
; TO MOTHER'S MAIDEN NAME
1 ;
;;GUARANTOR NAME^?3^9000043.0101^.01^!^1^EDITGUAR
;;REFERENCE #^?0^9000043.0101^.02^!!^2^EDITREF
;;PO NUMBER^?3^9000043.0101^.03^?37^3^EDITPO
;;DATE OF BIRTH^?3^9000043.0101^.04^!^4^EDITDOB^
;;GENDER^?3^9000043.0101^.05^!^5^EDITSEX
;;-Effective Date--------------------------Expiration Date------------------------
;;^?0^9000043.0111^.01^!?0^^NEWEFFDT
;;-GUARANTOR ADDRESS--------------------------------------------------------------
;;STREET^?3^9000043.0101V^.02^!^^EDITADD|||I 0
;;MOTHER'S MAIDEN NAME^?3^2^.2403^?40^^^|||W $C(124)
;;CITY,STATE,ZIP^?3^9000043.0101V^.03;.04;.05^!^^|;;|||W ", ";W " ";|
;;FATHER'S NAME^?3^2^.2401^?40^^^|||W $C(124)
;;PHONE^?3^9000043.0101V^.06^!^^^
;;-DEPENDENTS-------------------HRN--------------REL----------------AGE-----------
;;^?0^XXXXXXXXX^.06^?0^^^
;;*END*
AGEDGUAR ; IHS/ASDS/TPF - EDIT/DISP GUARANTOR SCREEN ;
+1 ;;7.1;PATIENT REGISTRATION;**1,2**;JAN 31, 2007
+2 ;
EN(GD0,GD1,GD2,NEWENTRY,AGSELECT,ALLFLDRQ) ;EP -
+1 ;ALLFLDRQ = TRUE IF THE PAT IS NON-INDIAN
+2 IF $GET(ALLFLDRQ)=""
SET ALLFLDRQ=$$ISNONIND^AGUTILS(DFN)
+3 IF $GET(AGSELECT)'=""
SET NONPER=$PIECE(AGSELECT,U,14)'[("AUPNPAT")
+4 KILL GUARDEL
+5 SET EXIT=0
+6 IF NEWENTRY
Begin DoDot:1
+7 SET SAME=0
+8 DO DRAW
DO WMSG
+9 DO NEWENTRY
IF EXIT
QUIT
+10 DO NEWGUAR
IF EXIT
QUIT
+11 IF 'SAME
DO EDITDOB
+12 DO EDITPO
+13 IF 'SAME
DO EDITSEX
+14 DO NEWEFFDT
IF EXIT
QUIT
+15 IF 'SAME
DO EDITDEP
+16 SET COMPIEN=GD0_","_GD1_","_GD2
+17 ;S AGSELECT=$$UPDTSEL^AGUTILS("FINDGUAR",.AGINS,COMPIEN)
+18 ;AG*7.1*1 IM18549
SET AGSELECT=$$UPDTSEL^AGUTILS(.AGINS,COMPIEN,GD0_",0)")
+19 SET NEWENTRY=0
End DoDot:1
IF EXIT
WRITE !,"Entry not made."
HANG 2
DO CLEANZER(GD0)
DO END
QUIT
+20 SET COMPIEN=GD0_","_GD1_","_GD2
VAR DO DRAW
+1 IF $DATA(AGSEENLY)
KILL DIR
SET DIR("A")="Press Return..."
SET DIR(0)="FO"
DO ^DIR
QUIT
+2 WRITE !,AGLINE("EQ")
+3 KILL DIR
+4 SET DIR("A")="ENTER ACTION (<E>dit"_$SELECT($DATA(^XUSEC("AGZMGR",DUZ)):", <A>dd to the insurer file):",1:")")
+5 SET DIR(0)="SAO^"_$SELECT($DATA(^XUSEC("AGZMGR",DUZ)):"A:ADD;",1:"")_"E:EDIT"
+6 DO ^DIR
+7 IF Y=""
IF ('$ORDER(^AUPNGUAR(GD0,1,GD1,11,0))!(GD2=""))
DO CLEAN(GD0)
DO END
QUIT
+8 IF $DATA(MYERRS("C","E"))
IF (Y'?1N.N)
IF (Y'="E")
IF ('ALLFLDRQ)
WRITE !,"ERRORS ON THIS PAGE. PLEASE EDIT BEFORE EXITING!!"
HANG 3
GOTO VAR
+9 IF Y=$GET(AGOPT("ESCAPE"))
QUIT
+10 IF ALLFLDRQ
IF (Y'?1N.N)
IF (Y'="E")
IF $$ALLFLDRQ(.ENTRYARY)
WRITE !,"PATIENT IS NON-INDIAN AND MUST HAVE ALL GUARANTOR DATA ENTERED!!"
HANG 3
GOTO VAR
+11 IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
QUIT
+12 IF Y="A"
DO ADDINS
GOTO VAR
+13 KILL DIR
+14 SET DIR("A")="CHANGE which item? (1-"_AG("N")_") NONE// "
+15 DO READ^AGED1
+16 IF ($DATA(MYERRS("C","E"))&(Y'?1N.N))
IF (Y'["V")
IF (Y'=AGOPT("ESCAPE"))
WRITE !,"ERRORS ON THIS PAGE. PLEASE FIX BEFORE EXITING!!"
HANG 3
GOTO VAR
+17 IF Y=$GET(AGOPT("ESCAPE"))
QUIT
+18 IF (ALLFLDRQ&(Y'?1N.N))
IF (Y'=AGOPT("ESCAPE"))
IF $$ALLFLDRQ(.ENTRYARY)
WRITE !,"PATIENT IS NON-INDIAN AND MUST HAVE ALL GUARANTOR DATA ENTERED!!"
HANG 3
GOTO VAR
+19 IF $DATA(DLOUT)!(Y["N")!$DATA(DUOUT)
GOTO END
IF $DATA(AG("ERR"))
GOTO VAR
+20 IF $DATA(DFOUT)!$DATA(DTOUT)
QUIT
+21 IF $DATA(DQOUT)!(+Y<1)!(+Y>AG("N"))
WRITE !!,"You must enter a number from 1 to ",AG("N")
HANG 2
GOTO VAR
+22 SET AGY=Y
+23 FOR AGI=1:1
SET AG("SEL")=+$PIECE(AGY,",",AGI)
IF AG("SEL")<1!(AG("SEL")>AG("N"))
QUIT
DO @($PIECE(AG("C"),",",AG("SEL")))
+24 ;NO GUAR, RET TO SUMM PG
IF $GET(GUARDEL)
QUIT
+25 ;S AGSELECT=$$UPDTSEL^AGUTILS("FINDGUAR",.AGINS,COMPIEN)
+26 ;S AGSELECT=$$UPDTSEL^AGUTILS(.AGINS,COMPIEN,$P(AGSELECT,U,2)) ;AG*7.1*1 IM18549
+27 ;AG*7.1*2 ERROR FOUND IN PATCH 2 TESTING
SET AGSELECT=$$UPDTSEL^AGUTILS(.AGINS,COMPIEN,GD0_",0)")
+28 DO UPDATE1^AGED(DUZ(2),DFN,3,"")
+29 KILL AGI,AGY
+30 GOTO VAR
ADDINS ;EP - ADD INSURER TO AUTNINS
+1 DO ^AGBAN
DO ^AGTMINS
+2 QUIT
CLEAN(GD0) ;EP - DEL EMPTY REC
+1 IF '$ORDER(^AUPNGUAR(GD0,1,GD1,11,0))
Begin DoDot:1
+2 DO CLEANZER(GD0)
End DoDot:1
+3 QUIT
CLEANZER(GD0) ;EP
+1 KILL DIK,DA
+2 SET DIK="^AUPNGUAR("
SET DA=GD0
DO ^DIK
+3 QUIT
END KILL DLOUT,DTOUT,DFOUT,DQOUT,DA,DIC,DR,AGSCRN,Y,ADA,WDA,ADT,WDT,ADFN
+1 KILL WDFN,REC,NEWENTRY,ROUTID,DEFEDDT,ENTRYARY,DEFEFFDT,GUARDEL,COMPIEN
+2 QUIT
DRAW ;EP
+1 SET AG("PG")="4GUARA"
+2 SET ROUTID=$PIECE($TEXT(+1)," ")
+3 DO ^AGED
+4 DO GETAW
+5 QUIT
GETAW ;
+1 KILL DEFEFFDT,DEFDEPEN
+2 KILL AG("C")
+3 FOR AG=1:1
Begin DoDot:1
+4 SET AGSCRN=$PIECE($TEXT(@1+AG),";;",2,15)
+5 IF AGSCRN[("*END*")
QUIT
+6 SET CAPTION=$PIECE(AGSCRN,U)
+7 IF $EXTRACT(CAPTION)="-"
WRITE !,CAPTION
QUIT
+8 SET DIC=$PIECE(AGSCRN,U,3)
+9 SET DR=$PIECE(AGSCRN,U,4)
+10 SET NEWLINE=$PIECE(AGSCRN,U,5)
+11 SET CAPDENT=$PIECE(AGSCRN,U,2)
+12 SET ITEMNUM=$PIECE(AGSCRN,U,6)
+13 SET TAGCALL=$PIECE($PIECE(AGSCRN,U,7),"|",1)
+14 SET EXECUTE=$PIECE(AGSCRN,"|",2)
+15 SET PREEXEC=$PIECE(AGSCRN,"|",3)
+16 SET PRECAPEX=$PIECE(AGSCRN,"|",4)
+17 SET POSTEXEC=$PIECE(AGSCRN,"|",5)
+18 IF TAGCALL'=""
SET $PIECE(AG("C"),",",ITEMNUM)=TAGCALL
+19 WRITE @NEWLINE
+20 WRITE ITEMNUM
+21 WRITE $SELECT(ITEMNUM'="":". ",1:"")
+22 IF PRECAPEX=""
WRITE @CAPDENT,$SELECT($GET(CAPTION)'="":CAPTION_": ",$GET(CAPTION)="":"",1:$PIECE($GET(^DD(DIC,DR,0)),U)_": ")
+23 IF PRECAPEX'=""
XECUTE PRECAPEX
IF $TEST
WRITE @CAPDENT,$SELECT($GET(CAPTION)'="":CAPTION_": ",$GET(CAPTION)="":"",1:$PIECE($GET(^DD(DIC,DR,0)),U)_": ")
+24 IF 'NEWENTRY
Begin DoDot:2
+25 SET FLAG=""
+26 SET D0=GD0
+27 IF DIC'["."
SET D0=D0_","
+28 IF '$TEST
SET D0=GD1_","_D0_","
+29 IF DIC[("V")
Begin DoDot:3
+30 SET DIC=$$GETVDIC($PIECE($PIECE($GET(^AUPNGUAR(GD0,1,GD1,0)),U),";",2))
+31 SET D0=$PIECE($PIECE($GET(^AUPNGUAR(GD0,1,GD1,0)),U),";")
+32 IF DIC=9000001
IF (DR=.02)
SET DIC=2
SET DR=".111"
+33 IF DIC=9000001
IF (DR=".03;.04;.05")
SET DIC=2
SET DR=".114;.115;.116"
+34 IF DIC=9000001
IF (DR=.06)
SET DIC=2
SET DR=.131
End DoDot:3
+35 ;I DIC=9000043.0111 S ITEMNUM=5 S WD0=","_GD1_","_GD0_"," D GETDATES(WD0) Q
+36 ;AG*7.1*1 SAC REQUIREMENT ROUTINE TOO LARGE MOVED SUBRTN
IF DIC=9000043.0111
SET ITEMNUM=5
SET WD0=","_GD1_","_GD0_","
DO GETDATES^AGEDGUA1(WD0)
QUIT
+37 NEW PIECE
+38 SET VDR=DR
+39 FOR PIECE=1:1
SET DR=$PIECE(VDR,";",PIECE)
IF DR=""
QUIT
Begin DoDot:3
+40 IF CAPTION="STREET"
SET ITEMNUM=AG("N")
SET ITEMNUM=ITEMNUM+1
WRITE ?0,ITEMNUM_". STREET: "
SET AG("N")=ITEMNUM
SET $PIECE(AG("C"),",",ITEMNUM)=TAGCALL
+41 IF DIC=2
IF (DR=.115)
SET DR="STATE:ABBREVIATION"
+42 IF DIC'=9000043.0101
IF (DR=.04)
SET DR="STATE:ABBREVIATION"
+43 IF $PIECE(PREEXEC,";",PIECE)'=""
XECUTE $PIECE(PREEXEC,";",PIECE)
+44 IF $PIECE(EXECUTE,";",PIECE)=""
SET ENTRY=$$GET1^DIQ(DIC,D0,DR,FLAG)
WRITE ENTRY
IF ITEMNUM'=""
SET ENTRYARY(ITEMNUM)=ENTRY
+45 IF $PIECE(EXECUTE,";",PIECE)'=""
SET D0=$TRANSLATE(D0,",")
XECUTE $PIECE(EXECUTE,";",PIECE)
+46 IF $PIECE(POSTEXEC,";",PIECE)'=""
XECUTE $PIECE(POSTEXEC,";",PIECE)
End DoDot:3
+47 KILL PIECE,VDR
+48 IF DIC="XXXXXXXXX"
Begin DoDot:3
+49 SET ITEMNUM=AG("N")
+50 SET AG("FLDCNT")=ITEMNUM
+51 IF $DATA(AG("TMPDEP"))
KILL AG("TMPDEP")
+52 DO FINDDEP
End DoDot:3
End DoDot:2
End DoDot:1
IF $GET(AGSCRN)[("*END*")
QUIT
+53 KILL MYERRS,MYVARS
+54 DO FETCHERR^AGEDERR(AG("PG"),.MYERRS)
+55 SET MYVARS("DFN")=DFN
SET MYVARS("FINDCALL")="FINDGUAR"
SET MYVARS("SELECTION")=$GET(AGSELECT)
SET MYVARS("SITE")=DUZ(2)
+56 IF '$GET(NEWENTRY)
DO EDITCHEK^AGEDERR(.MYERRS,.MYVARS,1)
+57 WRITE !,$GET(AGLINE("-"))
+58 DO VERIF^AGUTILS
+59 QUIT
GETVDIC(VROOT) ;EP - PROCESS VAR PTR FLD
+1 IF VROOT=""
QUIT ""
+2 SET VROOT=U_VROOT_"0)"
+3 QUIT +$PIECE($GET(@VROOT),U,2)
WMSG ;EP - MSG TO DISP IF NO ENTRY IN FILE
+1 WRITE !,"You must first enter a GUARANTOR"
+2 QUIT
NEWENTRY ;EP - CREATE TOP LEVEL
+1 WRITE !!
+2 KILL DIC,DIE,DR,DA
+3 SET DIC="^AUPNGUAR("
+4 SET DIC(0)="L"
+5 SET X="`"_DFN
+6 KILL DD,DO
+7 DO ^DIC
+8 IF +Y<0
SET EXIT=1
+9 SET GD0=+Y
+10 ;S NEWENTRY=0
+11 QUIT
NEWGUAR ;
+1 KILL DIR
+2 SET DIR("B")="SAME"
+3 SET DIR("A")="Select GUARANTOR"
+4 SET DIR(0)="FO^1:30"
+5 DO ^DIR
+6 IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
SET EXIT=1
QUIT
+7 SET X=Y
+8 SET SAME=X="SAME"
+9 IF X="SAME"
DO SAME(DFN)
QUIT
+10 KILL DIC,DIE,DR,DA,DIR
+11 SET TEMPDFN=DFN
+12 SET DA(1)=GD0
+13 SET DIC("S")="I $G(Y)'=TEMPDFN"
+14 SET DIC="^AUPNGUAR("_DA(1)_",1,"
+15 SET DIC(0)="MEQL"
+16 KILL DD,DO
+17 DO ^DIC
+18 SET DFN=TEMPDFN
+19 ;I +Y<0,(X="SAME") D SAME Q
+20 IF +Y<0
SET EXIT=1
QUIT
+21 SET GD1=+Y
+22 IF ALLFLDRQ
IF (+Y<0)
WRITE !,"PATIENT IS NON-INDIAN AND MUST HAVE ALL GUARANTOR DATA ENTERED!!"
HANG 3
GOTO NEWGUAR
+23 ;NOT IN AUPNPAT SO THIS IS NOT A PERSON
SET NONPER=$PIECE(Y,U,2)'[("AUPNPAT")
+24 ;THIS DEPENDS ON WHAT THEY DECIDE TO DO ABOUT ENTERING GURANTORS WHICH ARE NOT
+25 ;PATS AND ARE NOT EMPLOYERS OR INSURERS
+26 IF ALLFLDRQ
IF +Y
SET ENTRYARY(1)=+Y
+27 QUIT
+28 ;IF SAME ENTERED THEN THE GUARANTOR IS THE PATIENT
SAME(X) ;EP
+1 ;IF THE USER ENTERS SAME THEN IT IS ASSUMED THE GUARANTOR IS THE SAME AS
+2 ;THE PATIENT SO THE LOOKUP WILL ONLY BE ON THE PATIENT FILE
+3 NEW SAMESEX
+4 SET DIC("V")="I +Y(0)=9000001"
+5 SET DA(1)=GD0
+6 SET DIC="^AUPNGUAR("_DA(1)_",1,"
+7 SET DIC(0)="LMEQ"
+8 KILL DD,DO
+9 SET TEMPDFN=X
+10 SET X=$PIECE($GET(^DPT(X,0)),U)
+11 DO ^DIC
+12 IF +Y<0
SET EXIT=1
QUIT
+13 SET DFN=TEMPDFN
+14 SET GD1=+Y
+15 SET SAMESEX=$PIECE($GET(^DPT(DFN,0)),U,2)
+16 SET SAMEDOB=$PIECE($GET(^DPT(DFN,0)),U,3)
+17 KILL DIC,DR,DIE,DA,DD,DO
+18 SET DA(1)=GD0
+19 SET DA=GD1
+20 SET DIE="^AUPNGUAR("_DA(1)_",1,"
+21 SET DR=".04///^S X=SAMEDOB;.05///^S X=SAMESEX;.06///^S X=""SELF"""
+22 DO ^DIE
+23 QUIT
NEWEFFDT ;
+1 KILL DIC,DIE,DR,DA,X
+2 SET DA(2)=GD0
+3 SET DA(1)=GD1
+4 SET DIC="^AUPNGUAR("_DA(2)_",1,"_DA(1)_",11,"
+5 SET DIC(0)="ALMEQ"
+6 IF $GET(AGY)'=""
IF $DATA(DEFEFFDT(AGY))
SET DIC("B")=$GET(DEFEFFDT(AGY))
+7 KILL DD,DO
+8 DO ^DIC
+9 IF +Y<0
SET EXIT=1
QUIT
+10 SET GD2=+Y
+11 IF ALLFLDRQ
IF (+Y<0)
WRITE !,"PATIENT IS NON-INDIAN AND MUST HAVE ALL GUARANTOR DATA ENTERED!!"
HANG 3
GOTO NEWEFFDT
+12 IF $PIECE(Y,U,3)
DO EDITEXP
QUIT
+13 DO EDITEFF
+14 QUIT
EDITGUAR ;GUAR NAME
+1 KILL DIC,DR,DIE,DA,DD,DO,DIR
+2 SET GUARDEL=0
+3 SET DA(1)=GD0
+4 SET DA=GD1
+5 SET DIE="^AUPNGUAR("_DA(1)_",1,"
+6 SET DR=.01
+7 IF ALLFLDRQ
SET DR=".01R"
SET DIE("NO^")=""
+8 IF DR'[("R")
IF $$ISREQ^AGFLDREQ(9000043,.01)
SET DIE("NO^")=""
SET DR=".01R"
+9 DO ^DIE
+10 IF ALLFLDRQ
SET ENTRYARY(1)=$GET(X)
+11 IF '$DATA(DA)
SET GUARDEL=1
+12 KILL DIC,DR,DIE,DA
+13 QUIT
EDITREF ;REF #
+1 KILL DIC,DR,DIE,DA,DD,DO
+2 SET DA(1)=GD0
+3 SET DA=GD1
+4 SET DIE="^AUPNGUAR("_DA(1)_",1,"
+5 SET DR=.02
+6 IF ALLFLDRQ
SET DR=".02R"
SET DIE("NO^")=""
+7 IF DR'[("R")
IF $$ISREQ^AGFLDREQ(9000043,.02)
SET DIE("NO^")=""
SET DR=".02R"
+8 DO ^DIE
+9 IF ALLFLDRQ
SET ENTRYARY(2)=$GET(X)
+10 KILL DIC,DR,DIE,DA
+11 QUIT
EDITPO ;PO #
+1 KILL DIC,DR,DIE,DA,DD,DO
+2 SET DA(1)=GD0
+3 SET DA=GD1
+4 SET DIE="^AUPNGUAR("_DA(1)_",1,"
+5 IF ALLFLDRQ
SET DR=".03R"
SET DIE("NO^")=""
+6 IF '$TEST
SET DR=.03
+7 DO ^DIE
+8 IF ALLFLDRQ
SET ENTRYARY(3)=$GET(X)
+9 KILL DIC,DR,DIE,DA
+10 QUIT
EDITDOB ;DOB
+1 KILL DIC,DR,DIE,DA,DD,DO
+2 SET DA(1)=GD0
+3 SET DA=GD1
+4 SET DIE="^AUPNGUAR("_DA(1)_",1,"
+5 SET DR=.04
+6 IF ALLFLDRQ
IF ('$GET(NONPER))
SET DR=".04R"
SET DIE("NO^")=""
+7 IF DR'[("R")
IF $$ISREQ^AGFLDREQ(9000043,.04)
SET DIE("NO^")=""
SET DR=".04R"
+8 DO ^DIE
+9 IF ALLFLDRQ
SET ENTRYARY(4)=$GET(X)
+10 KILL DIC,DR,DIE,DA
+11 QUIT
EDITSEX ;GENDER
+1 KILL DIC,DR,DIE,DA,DD,DO
+2 SET DA(1)=GD0
+3 SET DA=GD1
+4 SET DIE="^AUPNGUAR("_DA(1)_",1,"
+5 SET DR=.05
+6 IF ALLFLDRQ
IF ('$GET(NONPER))
SET DR=".05R"
SET DIE("NO^")=""
+7 IF DR'[("R")
IF $$ISREQ^AGFLDREQ(9000043,.05)
SET DIE("NO^")=""
SET DR=".05R"
+8 DO ^DIE
+9 KILL DIC,DR,DIE,DA
+10 QUIT
EDITEFF ;EFF DT
+1 KILL DIC,DR,DIE,DA,DD,DO
+2 SET DA=GD2
+3 SET DA(1)=GD1
+4 SET DA(2)=GD0
+5 SET DIE="^AUPNGUAR("_DA(2)_",1,"_DA(1)_",11,"
+6 IF ALLFLDRQ
SET DR(3,9000043.0111)=".01R"
SET DIE("NO^")=""
+7 IF '$TEST
SET DR(3,9000043.0111)=".01"
+8 SET DR=".01"
+9 DO ^DIE
+10 IF '$DATA(DA)
QUIT
+11 KILL DIC,DR,DIE,DA
+12 DO EDITEXP
+13 QUIT
EDITEXP ;EXP DT
+1 KILL DIC,DR,DIE,DA,DD,DO
+2 SET DA=GD2
+3 SET DA(1)=GD1
+4 SET DA(2)=GD0
+5 SET DIE="^AUPNGUAR("_DA(2)_",1,"_DA(1)_",11,"
+6 SET DR=".02"
+7 IF ALLFLDRQ
SET DR(3,9000043.0111)=".02R"
SET DIE("NO^")=""
+8 IF '$TEST
SET DR(3,9000043.0111)=".02"
+9 DO ^DIE
+10 KILL DIC,DR,DIE,DA
+11 QUIT
+12 ;EDIT ADDRESS OF GUARANTOR
EDITADD ;EP
+1 KILL DIC,DR,DIE,DA,DD,DO
+2 ;IF ALL ADDRESS FIELD ARE MISSING
+3 SET ALLOW=$$GUARADD^AGEDERR2($GET(AGSELECT))
+4 IF 'ALLOW
WRITE !,"ADDRESS MUST BE EDITED IN TABLE MAINTENANCE!!"
HANG 2
QUIT
+5 ;WHAT FILE ARE WE LOOKING AT?
+6 SET DIE=$PIECE(^AUPNGUAR(GD0,1,GD1,0),U)
+7 SET DA=$PIECE(DIE,";")
+8 SET DIE=U_$PIECE(DIE,";",2)
+9 IF DIE[("AUPNPAT")
SET DIE="^DPT("
+10 IF DIE[("DPT")
SET DR=".111;.114;.115;.116;.131"
+11 IF '$TEST
SET DR=".02;.03;.04;.05;.06"
+12 DO ^DIE
+13 QUIT
ALLFLDRQ(ARRAY) ;EP - ARE ALL FLDS ENTERED
+1 NEW MISSING
+2 SET MISSING=0
+3 SET ITEM=""
FOR
SET ITEM=$ORDER(ARRAY(ITEM))
IF ITEM=""
QUIT
Begin DoDot:1
+4 IF $GET(NONPER)
IF (ITEM=4!(ITEM=5))
SET ARRAY(ITEM)="NA"
+5 IF $GET(ARRAY(ITEM))=""
SET MISSING=1
End DoDot:1
+6 QUIT MISSING
FINDDEP ;EP - FIND DEPS
+1 SET AG("DEP")=0
+2 SET AG("GUAR")=$PIECE($GET(^AUPNGUAR(GD0,1,GD1,0)),U)
+3 FOR
SET AG("DEP")=$ORDER(^AUPNGUAR("C",AG("GUAR"),AG("DEP")))
IF 'AG("DEP")
QUIT
Begin DoDot:1
+4 SET AG("PREC")=0
+5 FOR
SET AG("PREC")=$ORDER(^AUPNGUAR("C",AG("GUAR"),AG("DEP"),AG("PREC")))
IF 'AG("PREC")
QUIT
Begin DoDot:2
+6 SET AG("FLDCNT")=AG("FLDCNT")+1
SET AG("TMPDEP",AG("FLDCNT"))=AG("DEP")_U_AG("PREC")
+7 SET DEFDEPEN(AG("FLDCNT"))=AG("DEP")_","_AG("PREC")
+8 SET $PIECE(AG("C"),",",AG("FLDCNT"))="EDITDEP"
+9 WRITE !,AG("FLDCNT"),". ",?4,$PIECE($GET(^DPT(AG("DEP"),0)),U)
+10 WRITE ?30,$PIECE($GET(^AUPNPAT(AG("DEP"),41,DUZ(2),0)),U,2)
+11 IF $PIECE($GET(^AUPNGUAR(AG("DEP"),1,GD1,0)),U,6)'=""
Begin DoDot:3
+12 WRITE ?47,$PIECE($GET(^AUTTRLSH($PIECE($GET(^AUPNGUAR(AG("DEP"),1,GD1,0)),U,6),0)),U)
End DoDot:3
+13 WRITE ?67,$$AGE^AUPNPAT(AG("DEP"))
End DoDot:2
End DoDot:1
+14 KILL AG("DEP"),AG("PREC"),AG("GUAR")
+15 IF $DATA(AG("TMPDEP"))
SET AG("N")=AG("FLDCNT")
+16 QUIT
EDITDEP ;EP - EDIT RELATIONSHIP FLD OF DEP
+1 KILL DIC,DR,DIE,DA,DD,DO
+2 SET DA(1)=GD0
+3 SET DA=GD1
+4 IF $GET(AGY)'=""
IF $DATA(DEFDEPEN(AGY))
SET DA=$PIECE($GET(DEFDEPEN(AGY)),",",2)
SET DA(1)=$PIECE($GET(DEFDEPEN(AGY)),",")
+5 SET DIE="^AUPNGUAR("_DA(1)_",1,"
+6 SET DR=".06"
+7 IF ALLFLDRQ
IF ('$GET(NONPER))
SET DR=".06R"
SET DIE("NO^")=""
+8 IF DR'[("R")
IF $$ISREQ^AGFLDREQ(9000043,.06)
SET DIE("NO^")=""
SET DR=".06R"
+9 DO ^DIE
+10 KILL DIC,DR,DIE,DA
+11 QUIT
+12 ;
+13 ; U "^" DELIMITED
+14 ; AGSCRN CONTAINS THE $TEXT OF EACH LINE BELOW STARTING AT TAG '1'
+15 ; PIECE VAR DESC
+16 ; ----- -------- -----------
+17 ; 1 CAPTION FLD CAP ASSIGNED BY PROGRAMMER OVERRIDES FLD LABEL IF POPULATED
+18 ; 2 CAPDENT POS ON LINE TO DISP CAP
+19 ; 3 DIC FILE OR SUBFILE #
+20 ; 4 DR FLD # - THESE CAN BE SEPARATED BY ";" THIS ALLOWS
+21 ; MULT FLDS TO BE PRINTED WITH THE SAME CAP AS IN 'CITY,STATE,ZIP'
+22 ; 5 NEWLINE NEW LINE OR NOT (MUST BE EITHER A '!' OR '?#') USE THIS TO INDENT THE LINE
+23 ; 6 ITEMNUM ITEM # ASSIGNMENT. USE THIS TO ASSIGN THE ITEM # USED TO CHOOSE THIS FLD ON THE SCREEN
+24 ; 7 TAGCALL TAG TO CALL WHEN THIS FLD IS CHOSEN BY USER TO EDIT
+25 ; BAR "|" DELIMITED
+26 ; PIECE VAR DESC
+27 ; ----- -------- -----------
+28 ; 2 EXECUTE EXECUTE CODE TO GET FLD THAT ANOTHER IS POINTING TO.
+29 ; EXECUTED AFT FLD PRINT. IF MULT FLDS ARE PRINTED
+30 ; THEN MULT EXECUTE CODES CAN BE SEPARATED BY ";".
+31 ; 3 PREEXEC EXECUTE CODE TO DO BEF FLD PRINTS. USE TO SCREEN OUT
+32 ; PRINTING A FLD VALUE. FOR MULT SEPARATE BY ";"
+33 ; 4 PRECAPEX EXECUTE CODE TO DO BEF PRINTING THE CAP OR FLD LBL.
+34 ; USE TO SCREEN OUT PRINTING A CAP/FLD LBL
+35 ; 5 POSTEXEC EXECUTE CODE TO DO AFT PRINTING THE FLD DATA FOR MULT SEPARATE BY ";"
+36 ;
+37 ;AG*7.1*2 CHANGED ;;MOTHER'S NAME^?3^2^.2402^?45^^^|||W $C(124)
+38 ; TO MOTHER'S MAIDEN NAME
1 ;
+1 ;;GUARANTOR NAME^?3^9000043.0101^.01^!^1^EDITGUAR
+2 ;;REFERENCE #^?0^9000043.0101^.02^!!^2^EDITREF
+3 ;;PO NUMBER^?3^9000043.0101^.03^?37^3^EDITPO
+4 ;;DATE OF BIRTH^?3^9000043.0101^.04^!^4^EDITDOB^
+5 ;;GENDER^?3^9000043.0101^.05^!^5^EDITSEX
+6 ;;-Effective Date--------------------------Expiration Date------------------------
+7 ;;^?0^9000043.0111^.01^!?0^^NEWEFFDT
+8 ;;-GUARANTOR ADDRESS--------------------------------------------------------------
+9 ;;STREET^?3^9000043.0101V^.02^!^^EDITADD|||I 0
+10 ;;MOTHER'S MAIDEN NAME^?3^2^.2403^?40^^^|||W $C(124)
+11 ;;CITY,STATE,ZIP^?3^9000043.0101V^.03;.04;.05^!^^|;;|||W ", ";W " ";|
+12 ;;FATHER'S NAME^?3^2^.2401^?40^^^|||W $C(124)
+13 ;;PHONE^?3^9000043.0101V^.06^!^^^
+14 ;;-DEPENDENTS-------------------HRN--------------REL----------------AGE-----------
+15 ;;^?0^XXXXXXXXX^.06^?0^^^
+16 ;;*END*
