AGGUPMCR ;VNGT/HS/ALA-Update Medicare ; 20 May 2010 5:20 PM
;;1.0;PATIENT REGISTRATION GUI;**1**;Nov 15, 2010
;
; if needed Reference Routines
; AGED42 - EDIT - PAGE 4 NEW MEDICARE SCREEN
;
UPD(DATA,DFN,PROC,DEF,MIEN,PARMS) ; EP - AGG UPDATE MEDICARE
; Input
; DFN - Patient IEN
; MIEN - Multiple IEN
; PROC - 'A' to add, 'E' to edit, 'D' to delete
; DEF - Definition
; PARMS - Parameters
NEW UID,II,AGIEN,IENS,DA,AGIEN,FILE,IN3PB,FIELD,EXEC,NAME,PFIEN,PDATA,BQ,RIEN
NEW AGGMCESD,AGGMCINS,ERROR,AGGDATA,AGGUPD,AGI,AGJ,AGWP,CHIEN,PTYP,RESULT
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("AGGUPMCR",UID))
K @DATA
;
S II=0
S PROC=$G(PROC,""),RIEN=DFN,MIEN=$G(MIEN,""),PARMS=$G(PARMS,"")
S:MIEN=0 MIEN=""
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^AGGPTUPD D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
S @DATA@(II)="I00010RESULT^T01024ERROR^I00010RIEN^I00010MIEN"_$C(30)
;
S AGIEN=$O(^AGG(9009068.3,"B",DEF,""))
I AGIEN="" D Q
. S II=II+1,@DATA@(II)="-1^"_"RPC Call Failed: "_DEF_" Definition does not exist."_$C(30)
. S II=II+1,@DATA@(II)=$C(31)
S FILE=$P(^AGG(9009068.3,AGIEN,0),U,2)
;
I $G(^AUPNMCR(DFN,0))="" D
. NEW DLAYGO,DIC,X,Y,DINUM
. S DLAYGO=FILE,DIC(0)="L",DIC="^AUPNMCR(",(X,DINUM)=DFN
. K DO,DD D FILE^DICN
;if deleting a Medicare
I PROC="D" D G DONE
. I MIEN="" S DA=RIEN,IENS=$$IENS^DILF(.DA)
. I MIEN'="" S DA(1)=RIEN,DA=MIEN,IENS=$$IENS^DILF(.DA)
. S AGGUPD(FILE,IENS,.01)="@"
. D FILE^DIE("","AGGUPD","ERROR")
. I $D(ERROR) Q
;if adding a new Medicare
D PARS
;
I PROC="A" D
. I MIEN="",RIEN'="" D
.. I '$D(^AUPNMCR(RIEN,11,0)) S ^AUPNMCR(RIEN,11,0)="^9000003.11D^^"
.. I $G(AGGMCESD)="" Q
.. S DA(1)=RIEN,DLAYGO=FILE,DIC(0)="L",DIC="^AUPNMCR("_DA(1)_",11,"
.. S X=AGGMCESD
.. ;D ^DIC I Y=-1 K DO,DD D FILE^DICN
.. K DO,DD D FILE^DICN ;Always create a new entry on adds
.. S MIEN=+Y
;if editing a Medicare
I MIEN="" S DA=RIEN,IENS=$$IENS^DILF(.DA)
I MIEN'="" S DA(1)=RIEN,DA=MIEN,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(FILE,IENS,FIELD)=$G(@NAME)
;
I $G(AGGMCINS)="" S AGGDATA(9000003,DFN_",",.02)=$O(^AUTNINS("B","MEDICARE",""))
D FILE^DIE("","AGGDATA","ERROR")
;
OTH ;
I $G(AGGMCIMP)'="" D
. I $G(^AUPNMCR(DFN,12,0))="" S ^AUPNMCR(DFN,12,0)="^9000003.01201D^^"
. NEW DIC,DLAYGO,DA,Y,X
. S DIC(0)="L",DA(1)=DFN,DIC="^AUPNMCR("_DA(1)_",12,",X=AGGMCIMP
. D ^DIC
I $G(AGGMCABN)'="" D
. I $G(^AUPNMCR(DFN,13,0))="" S ^AUPNMCR(DFN,13,0)="^9000003.13D^^"
. NEW DIC,DLAYGO,DA,X,Y
. S DIC(0)="L",DA(1)=DFN,DIC="^AUPNMCR("_DA(1)_",13,",X=AGGMCABN
. D ^DIC
K AGGMCIMP,AGGMCABN
;
DONE ;
S RESULT=1_U_U_RIEN_U_MIEN
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)
;
; Set last date updated and updated by
I $P(RESULT,U,1)=1 D
. S AGGDATAI(9000001,DFN_",",.03)=DT,AGGDATAI(9000001,DFN_",",.12)=DUZ
. D FILE^DIE("I","AGGDATAI","ERROR")
. S ^AGPATCH($$NOW^XLFDT(),DUZ(2),RIEN)=""
. D EDIT^AGGEXPRT(DFN)
; Cleanup variables
S NAME=""
F S NAME=$O(^AGG(9009068.3,AGIEN,10,"AC",NAME)) Q:NAME="" K @NAME
K ERROR
Q
;
PATCH ;
NEW AGDTS,COV
S AGDTS=$$NOW^XLFDT(),COV=$P($G(^AUPNMCR(RIEN,11,MIEN,0)),U,3)
S ^AGPATCH(AGDTS,DUZ(2),RIEN,COV)="MCARE^"_$P($G(^AUPNMCR(RIEN,0)),U,3,4)_U_$G(^AUPNMCR(RIEN,11,MIEN,0))
S:$P($G(^AUPNMCR(RIEN,11,MIEN,0)),U,2)="" $P(^AGPATCH(AGDTS,DUZ(2),RIEN,COV),U,5)=DT
Q
;
MCD() ;EP
NEW IEN
S IEN=$O(^AUTNINS("B","MEDICARE",""))
Q IEN_$C(29)_"MEDICARE"
;
MCNM(DFN) ;EP - NAME
N IEN,NAME
S IEN=$O(^AUPNMCR("B",DFN,"")) I IEN]"" S NAME=$$GET1^DIQ(9000003,IEN_",",2101,"I") Q:NAME]"" NAME
Q $P(^DPT(DFN,0),U,1)
;
MCDB(DFN) ;EP - DOB
N IEN,DOB
S IEN=$O(^AUPNMCR("B",DFN,"")) I IEN]"" S DOB=$$FMTE^AGGUL1($$GET1^DIQ(9000003,IEN_",",2102,"I")) Q:DOB]"" DOB
Q $$FMTE^AGGUL1($$GET1^DIQ(2,DFN_",",.03,"I"))
;
MCLSTDT(DFN) ;EP - Medicare Last update
;
N IEN
S IEN=$O(^AUPNMCR("B",DFN,"")) Q:IEN="" ""
Q $$FMTE^AGGUL1($$GET1^DIQ(9000003,IEN_",",.07,"I"))
;
MCRQMB(DFN) ;EP - Medicare Beneficiary Status
N IEN
S IEN=$O(^AUPNMCR("B",DFN,"")) Q:IEN="" ""
Q $$GET1^DIQ(9000003,IEN_",",.08,"I")_$C(28)_$$GET1^DIQ(9000003,IEN_",",.08,"E")
;
MCRNMB(DFN) ;EP - Medicare Number
N IEN
S IEN=$O(^AUPNMCR("B",DFN,"")) Q:IEN="" ""
Q $$GET1^DIQ(9000003,IEN_",",.03,"E")
;
MCRSUF(DFN) ;EP - Medicare Suffix
N IEN
S IEN=$O(^AUPNMCR("B",DFN,"")) Q:IEN="" ""
Q $$GET1^DIQ(9000003,IEN_",",.04,"I")_$C(28)_$$GET1^DIQ(9000003,IEN_",",.04,"E")
;
MCRPRV(DFN) ;EP - Medicare Provider
N IEN
S IEN=$O(^AUPNMCR("B",DFN,"")) Q:IEN="" ""
Q $$GET1^DIQ(9000003,IEN_",",.14,"E")
;
MCRDTO(DFN) ;EP - Medicare Date Obtained
N IEN
S IEN=$O(^AUPNMCR("B",DFN,"")) Q:IEN="" ""
Q $$FMTE^AGGUL1($$GET1^DIQ(9000003,IEN_",",.16,"I"))
;
MCRCCF(DFN) ;EP - Medicare Card Copy on File
N IEN
S IEN=$O(^AUPNMCR("B",DFN,"")) Q:IEN="" ""
Q $$GET1^DIQ(9000003,IEN_",",.15,"I")_$C(28)_$$GET1^DIQ(9000003,IEN_",",.15,"E")
;
MCRABN(DFN) ;EP - Advance Beneficiary Notice
NEW ABN
S ABN=$O(^AUPNMCR(DFN,13,"B",""),-1)
I ABN=0 S ABN=""
Q $$FMTE^AGGUL1(ABN)
;
MCRINFM(DFN) ;EP - IMP MSG FORM MCR SIG OBTAINED
NEW SIGD
S SIGD=$O(^AUPNMCR(DFN,12,"B",""),-1)
I SIGD=0 S SIGD=""
Q $$FMTE^AGGUL1(SIGD)
;
TRIG(DATA,DFN) ;EP - AGG MEDICARE TRIGGER
; Input
; DFN - Patient record
; PROC - Process; 'A' is add
;
NEW UID,II,VISIBLE
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("AGGUPMCR",UID))
K @DATA
;
S II=0
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^AGGUPMCR D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
D HDR^AGGWTRIG
S @DATA@(II)=HDR_$C(30)
;
;Always disable Date of Last Update field
S SOURCE="AGGLSTDT",HELP="",TYPE="D",VALUE=$$MCLSTDT(DFN),ABLE="N" S:VALUE="" VISIBLE="N" D UP^AGGWTRIG
;
;Fill in Release of Information Date
S SOURCE="AGGMCROI",HELP="",TYPE="D",VALUE=$$FMTE^AGGUL1($$GET1^DIQ(9000001,DFN_",",.04,"I")),ABLE="Y",VISIBLE="Y" D UP^AGGWTRIG
;
;If Release of Information Date is Blank, disable other fields
I $$GET1^DIQ(9000001,DFN_",",.04,"I")="" D G XTRIG
. ;
. S SOURCE="AGGMCNME",TYPE="X",VALUE="",ABLE="N",VISIBLE="Y",HELP="" D UP^AGGWTRIG
. S SOURCE="AGGMCNUM",TYPE="X",VALUE="",ABLE="N",VISIBLE="Y",HELP="" D UP^AGGWTRIG
. S SOURCE="AGGMCSUF",TYPE="T",VALUE="",ABLE="N",VISIBLE="Y",HELP="" D UP^AGGWTRIG
. S SOURCE="AGGMCINS",TYPE="T",VALUE="",ABLE="N",VISIBLE="Y",HELP="" D UP^AGGWTRIG
. S SOURCE="AGGMCPCP",TYPE="X",VALUE="",ABLE="N",VISIBLE="Y",HELP="" D UP^AGGWTRIG
. S SOURCE="AGGMCDOB",TYPE="D",VALUE="",ABLE="N",VISIBLE="Y",HELP="" D UP^AGGWTRIG
. S SOURCE="AGGMCCCF",TYPE="K",VALUE="",ABLE="N",VISIBLE="Y",HELP="" D UP^AGGWTRIG
. S SOURCE="AGGMCCRD",TYPE="D",VALUE="",ABLE="N",VISIBLE="Y",HELP="" D UP^AGGWTRIG
. S SOURCE="AGGMCQMB",TYPE="C",VALUE="",ABLE="N",VISIBLE="Y",HELP="" D UP^AGGWTRIG
. S SOURCE="MCELIG",TYPE="M",VALUE="",ABLE="N",VISIBLE="Y",HELP="" D UP^AGGWTRIG
. S SOURCE="SEQNBR",TYPE="X",VALUE="",ABLE="N",VISIBLE="Y",HELP="" D UP^AGGWTRIG
. S SOURCE="AGGMCABN",TYPE="D",VALUE="",ABLE="N",VISIBLE="Y",HELP="" D UP^AGGWTRIG
. S SOURCE="AGGMCIMP",TYPE="D",VALUE="",ABLE="N",VISIBLE="Y",HELP="" D UP^AGGWTRIG
;
S SOURCE="AGGMCINS",ABLE="Y",HELP="",VISIBLE="Y",TYPE="T",VALUE=$$MCD() D UP^AGGWTRIG
S SOURCE="AGGMCNME",ABLE="Y",HELP="",VISIBLE="Y",TYPE="X",VALUE=$$MCNM(DFN) D UP^AGGWTRIG
S SOURCE="AGGMCDOB",ABLE="Y",HELP="",VISIBLE="Y",TYPE="D",VALUE=$$MCDB(DFN) D UP^AGGWTRIG
S SOURCE="AGGMCQMB",ABLE="Y",HELP="",VISIBLE="Y",TYPE="C",VALUE=$$MCRQMB(DFN) D UP^AGGWTRIG
S SOURCE="AGGMCNUM",ABLE="Y",HELP="",VISIBLE="Y",TYPE="X",VALUE=$$MCRNMB(DFN) D UP^AGGWTRIG
S SOURCE="AGGMCSUF",ABLE="Y",HELP="",VISIBLE="Y",TYPE="T",VALUE=$$MCRSUF(DFN) D UP^AGGWTRIG
S SOURCE="AGGMCPCP",ABLE="Y",HELP="",VISIBLE="Y",TYPE="X",VALUE=$$MCRPRV(DFN) D UP^AGGWTRIG
S SOURCE="AGGMCCRD",ABLE="Y",HELP="",VISIBLE="Y",TYPE="D",VALUE=$$MCRDTO(DFN) D UP^AGGWTRIG
S SOURCE="AGGMCCCF",ABLE="Y",HELP="",VISIBLE="Y",TYPE="C",VALUE=$$MCRCCF(DFN) D UP^AGGWTRIG
S SOURCE="AGGMCABN",ABLE="Y",HELP="",VISIBLE="Y",TYPE="D",VALUE=$$MCRABN(DFN) D UP^AGGWTRIG
S SOURCE="AGGMCIMP",ABLE="Y",HELP="",VISIBLE="Y",TYPE="D",VALUE=$$MCRINFM(DFN) D UP^AGGWTRIG
;
XTRIG S II=II+1,@DATA@(II)=$C(31)
Q
;
ROI(DATA,DFN,AGGMCROI) ;EP - AGG MEDICARE ROI TRIGGER
; Input
; DFN - Patient IEN
; AGGMCROI - Release of Information Date
;
NEW UID,II,SOURCE,TYPE,VALUE,ABLE,VISIBLE,HELP,HDR
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("AGGUPMCR",UID))
K @DATA
;
S II=0
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^AGGUPMCR D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
D HDR^AGGWTRIG
S @DATA@(II)=HDR_$C(30)
;
;If Release of Information Date is Blank, disable other fields
I $G(AGGMCROI)]"" D G XROI
. ;
. S SOURCE="AGGMCNME",TYPE="X",VALUE=$$MCNM(DFN),ABLE="Y",VISIBLE="",HELP="" D UP^AGGWTRIG
. S SOURCE="AGGMCNUM",TYPE="X",VALUE="",ABLE="Y",VISIBLE="",HELP="" D UP^AGGWTRIG
. S SOURCE="AGGMCSUF",TYPE="T",VALUE="",ABLE="Y",VISIBLE="",HELP="" D UP^AGGWTRIG
. S SOURCE="AGGMCINS",TYPE="T",VALUE="",ABLE="Y",VISIBLE="",HELP="" D UP^AGGWTRIG
. S SOURCE="AGGMCPCP",TYPE="X",VALUE="",ABLE="Y",VISIBLE="",HELP="" D UP^AGGWTRIG
. S SOURCE="AGGMCDOB",TYPE="D",VALUE=$$MCDB(DFN),ABLE="Y",VISIBLE="",HELP="" D UP^AGGWTRIG
. S SOURCE="AGGMCCCF",TYPE="K",VALUE="",ABLE="Y",VISIBLE="",HELP="" D UP^AGGWTRIG
. S SOURCE="AGGMCCRD",TYPE="D",VALUE="",ABLE="Y",VISIBLE="",HELP="" D UP^AGGWTRIG
. S SOURCE="AGGMCQMB",TYPE="C",VALUE="",ABLE="Y",VISIBLE="",HELP="" D UP^AGGWTRIG
. S SOURCE="MCELIG",TYPE="M",VALUE="",ABLE="Y",VISIBLE="",HELP="" D UP^AGGWTRIG
. S SOURCE="SEQNBR",TYPE="X",VALUE="",ABLE="Y",VISIBLE="",HELP="" D UP^AGGWTRIG
. S SOURCE="AGGMCABN",ABLE="Y",HELP="",VISIBLE="Y",TYPE="D",VALUE=$$MCRABN(DFN) D UP^AGGWTRIG
. S SOURCE="AGGMCIMP",ABLE="Y",HELP="",VISIBLE="Y",TYPE="D",VALUE=$$MCRINFM(DFN) D UP^AGGWTRIG
;
I $G(AGGMCROI)="" D G XROI
. ;
. S SOURCE="AGGMCNME",TYPE="X",VALUE="",ABLE="N",VISIBLE="",HELP="" D UP^AGGWTRIG
. S SOURCE="AGGMCNUM",TYPE="X",VALUE="",ABLE="N",VISIBLE="",HELP="" D UP^AGGWTRIG
. S SOURCE="AGGMCSUF",TYPE="T",VALUE="",ABLE="N",VISIBLE="",HELP="" D UP^AGGWTRIG
. S SOURCE="AGGMCINS",TYPE="T",VALUE="",ABLE="N",VISIBLE="",HELP="" D UP^AGGWTRIG
. S SOURCE="AGGMCPCP",TYPE="X",VALUE="",ABLE="N",VISIBLE="",HELP="" D UP^AGGWTRIG
. S SOURCE="AGGMCDOB",TYPE="D",VALUE="",ABLE="N",VISIBLE="",HELP="" D UP^AGGWTRIG
. S SOURCE="AGGMCCCF",TYPE="K",VALUE="",ABLE="N",VISIBLE="",HELP="" D UP^AGGWTRIG
. S SOURCE="AGGMCCRD",TYPE="D",VALUE="",ABLE="N",VISIBLE="",HELP="" D UP^AGGWTRIG
. S SOURCE="AGGMCQMB",TYPE="C",VALUE="",ABLE="N",VISIBLE="",HELP="" D UP^AGGWTRIG
. S SOURCE="MCELIG",TYPE="M",VALUE="",ABLE="N",VISIBLE="",HELP="" D UP^AGGWTRIG
. S SOURCE="SEQNBR",TYPE="X",VALUE="",ABLE="N",VISIBLE="",HELP="" D UP^AGGWTRIG
. S SOURCE="AGGMCABN",TYPE="D",VALUE="",ABLE="N",VISIBLE="Y",HELP="" D UP^AGGWTRIG
. S SOURCE="AGGMCIMP",TYPE="D",VALUE="",ABLE="N",VISIBLE="Y",HELP="" D UP^AGGWTRIG
;
XROI S II=II+1,@DATA@(II)=$C(31)
Q
;
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)
. ;I VALUE="" S VALUE="@"
. ;I VALUE="" Q
. 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
Q
AGGUPMCR ;VNGT/HS/ALA-Update Medicare ; 20 May 2010 5:20 PM
+1 ;;1.0;PATIENT REGISTRATION GUI;**1**;Nov 15, 2010
+2 ;
+3 ; if needed Reference Routines
+4 ; AGED42 - EDIT - PAGE 4 NEW MEDICARE SCREEN
+5 ;
UPD(DATA,DFN,PROC,DEF,MIEN,PARMS) ; EP - AGG UPDATE MEDICARE
+1 ; Input
+2 ; DFN - Patient IEN
+3 ; MIEN - Multiple IEN
+4 ; PROC - 'A' to add, 'E' to edit, 'D' to delete
+5 ; DEF - Definition
+6 ; PARMS - Parameters
+7 NEW UID,II,AGIEN,IENS,DA,AGIEN,FILE,IN3PB,FIELD,EXEC,NAME,PFIEN,PDATA,BQ,RIEN
+8 NEW AGGMCESD,AGGMCINS,ERROR,AGGDATA,AGGUPD,AGI,AGJ,AGWP,CHIEN,PTYP,RESULT
+9 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+10 SET DATA=$NAME(^TMP("AGGUPMCR",UID))
+11 KILL @DATA
+12 ;
+13 SET II=0
+14 SET PROC=$GET(PROC,"")
SET RIEN=DFN
SET MIEN=$GET(MIEN,"")
SET PARMS=$GET(PARMS,"")
+15 IF MIEN=0
SET MIEN=""
+16 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^AGGPTUPD D UNWIND^%ZTER"
+17 SET @DATA@(II)="I00010RESULT^T01024ERROR^I00010RIEN^I00010MIEN"_$CHAR(30)
+18 ;
+19 SET AGIEN=$ORDER(^AGG(9009068.3,"B",DEF,""))
+20 IF AGIEN=""
Begin DoDot:1
+21 SET II=II+1
SET @DATA@(II)="-1^"_"RPC Call Failed: "_DEF_" Definition does not exist."_$CHAR(30)
+22 SET II=II+1
SET @DATA@(II)=$CHAR(31)
End DoDot:1
QUIT
+23 SET FILE=$PIECE(^AGG(9009068.3,AGIEN,0),U,2)
+24 ;
+25 IF $GET(^AUPNMCR(DFN,0))=""
Begin DoDot:1
+26 NEW DLAYGO,DIC,X,Y,DINUM
+27 SET DLAYGO=FILE
SET DIC(0)="L"
SET DIC="^AUPNMCR("
SET (X,DINUM)=DFN
+28 KILL DO,DD
DO FILE^DICN
End DoDot:1
+29 ;if deleting a Medicare
+30 IF PROC="D"
Begin DoDot:1
+31 IF MIEN=""
SET DA=RIEN
SET IENS=$$IENS^DILF(.DA)
+32 IF MIEN'=""
SET DA(1)=RIEN
SET DA=MIEN
SET IENS=$$IENS^DILF(.DA)
+33 SET AGGUPD(FILE,IENS,.01)="@"
+34 DO FILE^DIE("","AGGUPD","ERROR")
+35 IF $DATA(ERROR)
QUIT
End DoDot:1
GOTO DONE
+36 ;if adding a new Medicare
+37 DO PARS
+38 ;
+39 IF PROC="A"
Begin DoDot:1
+40 IF MIEN=""
IF RIEN'=""
Begin DoDot:2
+41 IF '$DATA(^AUPNMCR(RIEN,11,0))
SET ^AUPNMCR(RIEN,11,0)="^9000003.11D^^"
+42 IF $GET(AGGMCESD)=""
QUIT
+43 SET DA(1)=RIEN
SET DLAYGO=FILE
SET DIC(0)="L"
SET DIC="^AUPNMCR("_DA(1)_",11,"
+44 SET X=AGGMCESD
+45 ;D ^DIC I Y=-1 K DO,DD D FILE^DICN
+46 ;Always create a new entry on adds
KILL DO,DD
DO FILE^DICN
+47 SET MIEN=+Y
End DoDot:2
End DoDot:1
+48 ;if editing a Medicare
+49 IF MIEN=""
SET DA=RIEN
SET IENS=$$IENS^DILF(.DA)
+50 IF MIEN'=""
SET DA(1)=RIEN
SET DA=MIEN
SET IENS=$$IENS^DILF(.DA)
+51 FOR BQ=1:1:$LENGTH(PARMS,$CHAR(28))
Begin DoDot:1
+52 SET PDATA=$PIECE(PARMS,$CHAR(28),BQ)
IF PDATA=""
QUIT
+53 SET NAME=$PIECE(PDATA,"=",1)
+54 SET PFIEN=$ORDER(^AGG(9009068.3,AGIEN,10,"AC",NAME,""))
+55 IF PFIEN=""
SET BMXSEC=NAME_" not a valid parameter for this update"
QUIT
+56 SET FIELD=$PIECE($GET(^AGG(9009068.3,AGIEN,10,PFIEN,3)),U,1)
+57 SET EXEC=$GET(^AGG(9009068.3,AGIEN,10,PFIEN,7))
+58 IF EXEC'=""
XECUTE EXEC
QUIT
+59 IF FIELD=""
QUIT
+60 SET AGGDATA(FILE,IENS,FIELD)=$GET(@NAME)
End DoDot:1
IF $GET(BMXSEC)'=""
QUIT
+61 ;
+62 IF $GET(AGGMCINS)=""
SET AGGDATA(9000003,DFN_",",.02)=$ORDER(^AUTNINS("B","MEDICARE",""))
+63 DO FILE^DIE("","AGGDATA","ERROR")
+64 ;
OTH ;
+1 IF $GET(AGGMCIMP)'=""
Begin DoDot:1
+2 IF $GET(^AUPNMCR(DFN,12,0))=""
SET ^AUPNMCR(DFN,12,0)="^9000003.01201D^^"
+3 NEW DIC,DLAYGO,DA,Y,X
+4 SET DIC(0)="L"
SET DA(1)=DFN
SET DIC="^AUPNMCR("_DA(1)_",12,"
SET X=AGGMCIMP
+5 DO ^DIC
End DoDot:1
+6 IF $GET(AGGMCABN)'=""
Begin DoDot:1
+7 IF $GET(^AUPNMCR(DFN,13,0))=""
SET ^AUPNMCR(DFN,13,0)="^9000003.13D^^"
+8 NEW DIC,DLAYGO,DA,X,Y
+9 SET DIC(0)="L"
SET DA(1)=DFN
SET DIC="^AUPNMCR("_DA(1)_",13,"
SET X=AGGMCABN
+10 DO ^DIC
End DoDot:1
+11 KILL AGGMCIMP,AGGMCABN
+12 ;
DONE ;
+1 SET RESULT=1_U_U_RIEN_U_MIEN
+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 ; Set last date updated and updated by
+7 IF $PIECE(RESULT,U,1)=1
Begin DoDot:1
+8 SET AGGDATAI(9000001,DFN_",",.03)=DT
SET AGGDATAI(9000001,DFN_",",.12)=DUZ
+9 DO FILE^DIE("I","AGGDATAI","ERROR")
+10 SET ^AGPATCH($$NOW^XLFDT(),DUZ(2),RIEN)=""
+11 DO EDIT^AGGEXPRT(DFN)
End DoDot:1
+12 ; Cleanup variables
+13 SET NAME=""
+14 FOR
SET NAME=$ORDER(^AGG(9009068.3,AGIEN,10,"AC",NAME))
IF NAME=""
QUIT
KILL @NAME
+15 KILL ERROR
+16 QUIT
+17 ;
PATCH ;
+1 NEW AGDTS,COV
+2 SET AGDTS=$$NOW^XLFDT()
SET COV=$PIECE($GET(^AUPNMCR(RIEN,11,MIEN,0)),U,3)
+3 SET ^AGPATCH(AGDTS,DUZ(2),RIEN,COV)="MCARE^"_$PIECE($GET(^AUPNMCR(RIEN,0)),U,3,4)_U_$GET(^AUPNMCR(RIEN,11,MIEN,0))
+4 IF $PIECE($GET(^AUPNMCR(RIEN,11,MIEN,0)),U,2)=""
SET $PIECE(^AGPATCH(AGDTS,DUZ(2),RIEN,COV),U,5)=DT
+5 QUIT
+6 ;
MCD() ;EP
+1 NEW IEN
+2 SET IEN=$ORDER(^AUTNINS("B","MEDICARE",""))
+3 QUIT IEN_$CHAR(29)_"MEDICARE"
+4 ;
MCNM(DFN) ;EP - NAME
+1 NEW IEN,NAME
+2 SET IEN=$ORDER(^AUPNMCR("B",DFN,""))
IF IEN]""
SET NAME=$$GET1^DIQ(9000003,IEN_",",2101,"I")
IF NAME]""
QUIT NAME
+3 QUIT $PIECE(^DPT(DFN,0),U,1)
+4 ;
MCDB(DFN) ;EP - DOB
+1 NEW IEN,DOB
+2 SET IEN=$ORDER(^AUPNMCR("B",DFN,""))
IF IEN]""
SET DOB=$$FMTE^AGGUL1($$GET1^DIQ(9000003,IEN_",",2102,"I"))
IF DOB]""
QUIT DOB
+3 QUIT $$FMTE^AGGUL1($$GET1^DIQ(2,DFN_",",.03,"I"))
+4 ;
MCLSTDT(DFN) ;EP - Medicare Last update
+1 ;
+2 NEW IEN
+3 SET IEN=$ORDER(^AUPNMCR("B",DFN,""))
IF IEN=""
QUIT ""
+4 QUIT $$FMTE^AGGUL1($$GET1^DIQ(9000003,IEN_",",.07,"I"))
+5 ;
MCRQMB(DFN) ;EP - Medicare Beneficiary Status
+1 NEW IEN
+2 SET IEN=$ORDER(^AUPNMCR("B",DFN,""))
IF IEN=""
QUIT ""
+3 QUIT $$GET1^DIQ(9000003,IEN_",",.08,"I")_$CHAR(28)_$$GET1^DIQ(9000003,IEN_",",.08,"E")
+4 ;
MCRNMB(DFN) ;EP - Medicare Number
+1 NEW IEN
+2 SET IEN=$ORDER(^AUPNMCR("B",DFN,""))
IF IEN=""
QUIT ""
+3 QUIT $$GET1^DIQ(9000003,IEN_",",.03,"E")
+4 ;
MCRSUF(DFN) ;EP - Medicare Suffix
+1 NEW IEN
+2 SET IEN=$ORDER(^AUPNMCR("B",DFN,""))
IF IEN=""
QUIT ""
+3 QUIT $$GET1^DIQ(9000003,IEN_",",.04,"I")_$CHAR(28)_$$GET1^DIQ(9000003,IEN_",",.04,"E")
+4 ;
MCRPRV(DFN) ;EP - Medicare Provider
+1 NEW IEN
+2 SET IEN=$ORDER(^AUPNMCR("B",DFN,""))
IF IEN=""
QUIT ""
+3 QUIT $$GET1^DIQ(9000003,IEN_",",.14,"E")
+4 ;
MCRDTO(DFN) ;EP - Medicare Date Obtained
+1 NEW IEN
+2 SET IEN=$ORDER(^AUPNMCR("B",DFN,""))
IF IEN=""
QUIT ""
+3 QUIT $$FMTE^AGGUL1($$GET1^DIQ(9000003,IEN_",",.16,"I"))
+4 ;
MCRCCF(DFN) ;EP - Medicare Card Copy on File
+1 NEW IEN
+2 SET IEN=$ORDER(^AUPNMCR("B",DFN,""))
IF IEN=""
QUIT ""
+3 QUIT $$GET1^DIQ(9000003,IEN_",",.15,"I")_$CHAR(28)_$$GET1^DIQ(9000003,IEN_",",.15,"E")
+4 ;
MCRABN(DFN) ;EP - Advance Beneficiary Notice
+1 NEW ABN
+2 SET ABN=$ORDER(^AUPNMCR(DFN,13,"B",""),-1)
+3 IF ABN=0
SET ABN=""
+4 QUIT $$FMTE^AGGUL1(ABN)
+5 ;
MCRINFM(DFN) ;EP - IMP MSG FORM MCR SIG OBTAINED
+1 NEW SIGD
+2 SET SIGD=$ORDER(^AUPNMCR(DFN,12,"B",""),-1)
+3 IF SIGD=0
SET SIGD=""
+4 QUIT $$FMTE^AGGUL1(SIGD)
+5 ;
TRIG(DATA,DFN) ;EP - AGG MEDICARE TRIGGER
+1 ; Input
+2 ; DFN - Patient record
+3 ; PROC - Process; 'A' is add
+4 ;
+5 NEW UID,II,VISIBLE
+6 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+7 SET DATA=$NAME(^TMP("AGGUPMCR",UID))
+8 KILL @DATA
+9 ;
+10 SET II=0
+11 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^AGGUPMCR D UNWIND^%ZTER"
+12 DO HDR^AGGWTRIG
+13 SET @DATA@(II)=HDR_$CHAR(30)
+14 ;
+15 ;Always disable Date of Last Update field
+16 SET SOURCE="AGGLSTDT"
SET HELP=""
SET TYPE="D"
SET VALUE=$$MCLSTDT(DFN)
SET ABLE="N"
IF VALUE=""
SET VISIBLE="N"
DO UP^AGGWTRIG
+17 ;
+18 ;Fill in Release of Information Date
+19 SET SOURCE="AGGMCROI"
SET HELP=""
SET TYPE="D"
SET VALUE=$$FMTE^AGGUL1($$GET1^DIQ(9000001,DFN_",",.04,"I"))
SET ABLE="Y"
SET VISIBLE="Y"
DO UP^AGGWTRIG
+20 ;
+21 ;If Release of Information Date is Blank, disable other fields
+22 IF $$GET1^DIQ(9000001,DFN_",",.04,"I")=""
Begin DoDot:1
+23 ;
+24 SET SOURCE="AGGMCNME"
SET TYPE="X"
SET VALUE=""
SET ABLE="N"
SET VISIBLE="Y"
SET HELP=""
DO UP^AGGWTRIG
+25 SET SOURCE="AGGMCNUM"
SET TYPE="X"
SET VALUE=""
SET ABLE="N"
SET VISIBLE="Y"
SET HELP=""
DO UP^AGGWTRIG
+26 SET SOURCE="AGGMCSUF"
SET TYPE="T"
SET VALUE=""
SET ABLE="N"
SET VISIBLE="Y"
SET HELP=""
DO UP^AGGWTRIG
+27 SET SOURCE="AGGMCINS"
SET TYPE="T"
SET VALUE=""
SET ABLE="N"
SET VISIBLE="Y"
SET HELP=""
DO UP^AGGWTRIG
+28 SET SOURCE="AGGMCPCP"
SET TYPE="X"
SET VALUE=""
SET ABLE="N"
SET VISIBLE="Y"
SET HELP=""
DO UP^AGGWTRIG
+29 SET SOURCE="AGGMCDOB"
SET TYPE="D"
SET VALUE=""
SET ABLE="N"
SET VISIBLE="Y"
SET HELP=""
DO UP^AGGWTRIG
+30 SET SOURCE="AGGMCCCF"
SET TYPE="K"
SET VALUE=""
SET ABLE="N"
SET VISIBLE="Y"
SET HELP=""
DO UP^AGGWTRIG
+31 SET SOURCE="AGGMCCRD"
SET TYPE="D"
SET VALUE=""
SET ABLE="N"
SET VISIBLE="Y"
SET HELP=""
DO UP^AGGWTRIG
+32 SET SOURCE="AGGMCQMB"
SET TYPE="C"
SET VALUE=""
SET ABLE="N"
SET VISIBLE="Y"
SET HELP=""
DO UP^AGGWTRIG
+33 SET SOURCE="MCELIG"
SET TYPE="M"
SET VALUE=""
SET ABLE="N"
SET VISIBLE="Y"
SET HELP=""
DO UP^AGGWTRIG
+34 SET SOURCE="SEQNBR"
SET TYPE="X"
SET VALUE=""
SET ABLE="N"
SET VISIBLE="Y"
SET HELP=""
DO UP^AGGWTRIG
+35 SET SOURCE="AGGMCABN"
SET TYPE="D"
SET VALUE=""
SET ABLE="N"
SET VISIBLE="Y"
SET HELP=""
DO UP^AGGWTRIG
+36 SET SOURCE="AGGMCIMP"
SET TYPE="D"
SET VALUE=""
SET ABLE="N"
SET VISIBLE="Y"
SET HELP=""
DO UP^AGGWTRIG
End DoDot:1
GOTO XTRIG
+37 ;
+38 SET SOURCE="AGGMCINS"
SET ABLE="Y"
SET HELP=""
SET VISIBLE="Y"
SET TYPE="T"
SET VALUE=$$MCD()
DO UP^AGGWTRIG
+39 SET SOURCE="AGGMCNME"
SET ABLE="Y"
SET HELP=""
SET VISIBLE="Y"
SET TYPE="X"
SET VALUE=$$MCNM(DFN)
DO UP^AGGWTRIG
+40 SET SOURCE="AGGMCDOB"
SET ABLE="Y"
SET HELP=""
SET VISIBLE="Y"
SET TYPE="D"
SET VALUE=$$MCDB(DFN)
DO UP^AGGWTRIG
+41 SET SOURCE="AGGMCQMB"
SET ABLE="Y"
SET HELP=""
SET VISIBLE="Y"
SET TYPE="C"
SET VALUE=$$MCRQMB(DFN)
DO UP^AGGWTRIG
+42 SET SOURCE="AGGMCNUM"
SET ABLE="Y"
SET HELP=""
SET VISIBLE="Y"
SET TYPE="X"
SET VALUE=$$MCRNMB(DFN)
DO UP^AGGWTRIG
+43 SET SOURCE="AGGMCSUF"
SET ABLE="Y"
SET HELP=""
SET VISIBLE="Y"
SET TYPE="T"
SET VALUE=$$MCRSUF(DFN)
DO UP^AGGWTRIG
+44 SET SOURCE="AGGMCPCP"
SET ABLE="Y"
SET HELP=""
SET VISIBLE="Y"
SET TYPE="X"
SET VALUE=$$MCRPRV(DFN)
DO UP^AGGWTRIG
+45 SET SOURCE="AGGMCCRD"
SET ABLE="Y"
SET HELP=""
SET VISIBLE="Y"
SET TYPE="D"
SET VALUE=$$MCRDTO(DFN)
DO UP^AGGWTRIG
+46 SET SOURCE="AGGMCCCF"
SET ABLE="Y"
SET HELP=""
SET VISIBLE="Y"
SET TYPE="C"
SET VALUE=$$MCRCCF(DFN)
DO UP^AGGWTRIG
+47 SET SOURCE="AGGMCABN"
SET ABLE="Y"
SET HELP=""
SET VISIBLE="Y"
SET TYPE="D"
SET VALUE=$$MCRABN(DFN)
DO UP^AGGWTRIG
+48 SET SOURCE="AGGMCIMP"
SET ABLE="Y"
SET HELP=""
SET VISIBLE="Y"
SET TYPE="D"
SET VALUE=$$MCRINFM(DFN)
DO UP^AGGWTRIG
+49 ;
XTRIG SET II=II+1
SET @DATA@(II)=$CHAR(31)
+1 QUIT
+2 ;
ROI(DATA,DFN,AGGMCROI) ;EP - AGG MEDICARE ROI TRIGGER
+1 ; Input
+2 ; DFN - Patient IEN
+3 ; AGGMCROI - Release of Information Date
+4 ;
+5 NEW UID,II,SOURCE,TYPE,VALUE,ABLE,VISIBLE,HELP,HDR
+6 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+7 SET DATA=$NAME(^TMP("AGGUPMCR",UID))
+8 KILL @DATA
+9 ;
+10 SET II=0
+11 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^AGGUPMCR D UNWIND^%ZTER"
+12 DO HDR^AGGWTRIG
+13 SET @DATA@(II)=HDR_$CHAR(30)
+14 ;
+15 ;If Release of Information Date is Blank, disable other fields
+16 IF $GET(AGGMCROI)]""
Begin DoDot:1
+17 ;
+18 SET SOURCE="AGGMCNME"
SET TYPE="X"
SET VALUE=$$MCNM(DFN)
SET ABLE="Y"
SET VISIBLE=""
SET HELP=""
DO UP^AGGWTRIG
+19 SET SOURCE="AGGMCNUM"
SET TYPE="X"
SET VALUE=""
SET ABLE="Y"
SET VISIBLE=""
SET HELP=""
DO UP^AGGWTRIG
+20 SET SOURCE="AGGMCSUF"
SET TYPE="T"
SET VALUE=""
SET ABLE="Y"
SET VISIBLE=""
SET HELP=""
DO UP^AGGWTRIG
+21 SET SOURCE="AGGMCINS"
SET TYPE="T"
SET VALUE=""
SET ABLE="Y"
SET VISIBLE=""
SET HELP=""
DO UP^AGGWTRIG
+22 SET SOURCE="AGGMCPCP"
SET TYPE="X"
SET VALUE=""
SET ABLE="Y"
SET VISIBLE=""
SET HELP=""
DO UP^AGGWTRIG
+23 SET SOURCE="AGGMCDOB"
SET TYPE="D"
SET VALUE=$$MCDB(DFN)
SET ABLE="Y"
SET VISIBLE=""
SET HELP=""
DO UP^AGGWTRIG
+24 SET SOURCE="AGGMCCCF"
SET TYPE="K"
SET VALUE=""
SET ABLE="Y"
SET VISIBLE=""
SET HELP=""
DO UP^AGGWTRIG
+25 SET SOURCE="AGGMCCRD"
SET TYPE="D"
SET VALUE=""
SET ABLE="Y"
SET VISIBLE=""
SET HELP=""
DO UP^AGGWTRIG
+26 SET SOURCE="AGGMCQMB"
SET TYPE="C"
SET VALUE=""
SET ABLE="Y"
SET VISIBLE=""
SET HELP=""
DO UP^AGGWTRIG
+27 SET SOURCE="MCELIG"
SET TYPE="M"
SET VALUE=""
SET ABLE="Y"
SET VISIBLE=""
SET HELP=""
DO UP^AGGWTRIG
+28 SET SOURCE="SEQNBR"
SET TYPE="X"
SET VALUE=""
SET ABLE="Y"
SET VISIBLE=""
SET HELP=""
DO UP^AGGWTRIG
+29 SET SOURCE="AGGMCABN"
SET ABLE="Y"
SET HELP=""
SET VISIBLE="Y"
SET TYPE="D"
SET VALUE=$$MCRABN(DFN)
DO UP^AGGWTRIG
+30 SET SOURCE="AGGMCIMP"
SET ABLE="Y"
SET HELP=""
SET VISIBLE="Y"
SET TYPE="D"
SET VALUE=$$MCRINFM(DFN)
DO UP^AGGWTRIG
End DoDot:1
GOTO XROI
+31 ;
+32 IF $GET(AGGMCROI)=""
Begin DoDot:1
+33 ;
+34 SET SOURCE="AGGMCNME"
SET TYPE="X"
SET VALUE=""
SET ABLE="N"
SET VISIBLE=""
SET HELP=""
DO UP^AGGWTRIG
+35 SET SOURCE="AGGMCNUM"
SET TYPE="X"
SET VALUE=""
SET ABLE="N"
SET VISIBLE=""
SET HELP=""
DO UP^AGGWTRIG
+36 SET SOURCE="AGGMCSUF"
SET TYPE="T"
SET VALUE=""
SET ABLE="N"
SET VISIBLE=""
SET HELP=""
DO UP^AGGWTRIG
+37 SET SOURCE="AGGMCINS"
SET TYPE="T"
SET VALUE=""
SET ABLE="N"
SET VISIBLE=""
SET HELP=""
DO UP^AGGWTRIG
+38 SET SOURCE="AGGMCPCP"
SET TYPE="X"
SET VALUE=""
SET ABLE="N"
SET VISIBLE=""
SET HELP=""
DO UP^AGGWTRIG
+39 SET SOURCE="AGGMCDOB"
SET TYPE="D"
SET VALUE=""
SET ABLE="N"
SET VISIBLE=""
SET HELP=""
DO UP^AGGWTRIG
+40 SET SOURCE="AGGMCCCF"
SET TYPE="K"
SET VALUE=""
SET ABLE="N"
SET VISIBLE=""
SET HELP=""
DO UP^AGGWTRIG
+41 SET SOURCE="AGGMCCRD"
SET TYPE="D"
SET VALUE=""
SET ABLE="N"
SET VISIBLE=""
SET HELP=""
DO UP^AGGWTRIG
+42 SET SOURCE="AGGMCQMB"
SET TYPE="C"
SET VALUE=""
SET ABLE="N"
SET VISIBLE=""
SET HELP=""
DO UP^AGGWTRIG
+43 SET SOURCE="MCELIG"
SET TYPE="M"
SET VALUE=""
SET ABLE="N"
SET VISIBLE=""
SET HELP=""
DO UP^AGGWTRIG
+44 SET SOURCE="SEQNBR"
SET TYPE="X"
SET VALUE=""
SET ABLE="N"
SET VISIBLE=""
SET HELP=""
DO UP^AGGWTRIG
+45 SET SOURCE="AGGMCABN"
SET TYPE="D"
SET VALUE=""
SET ABLE="N"
SET VISIBLE="Y"
SET HELP=""
DO UP^AGGWTRIG
+46 SET SOURCE="AGGMCIMP"
SET TYPE="D"
SET VALUE=""
SET ABLE="N"
SET VISIBLE="Y"
SET HELP=""
DO UP^AGGWTRIG
End DoDot:1
GOTO XROI
+47 ;
XROI SET II=II+1
SET @DATA@(II)=$CHAR(31)
+1 QUIT
+2 ;
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 ;I VALUE="" S VALUE="@"
+5 ;I VALUE="" Q
+6 SET PFIEN=$ORDER(^AGG(9009068.3,AGIEN,10,"AC",NAME,""))
+7 IF PFIEN=""
SET BMXSEC=NAME_" not a valid parameter for this update"
QUIT
+8 SET PTYP=$PIECE($GET(^AGG(9009068.3,AGIEN,10,PFIEN,1)),U,1)
+9 IF PTYP="D"
SET VALUE=$$DATE^AGGUL1(VALUE)
+10 IF PTYP="C"
Begin DoDot:2
+11 IF VALUE=""
QUIT
+12 SET CHIEN=$ORDER(^AGG(9009068.3,AGIEN,10,PFIEN,5,"B",VALUE,""))
IF CHIEN=""
QUIT
+13 SET VALUE=$PIECE(^AGG(9009068.3,AGIEN,10,PFIEN,5,CHIEN,0),U,2)
End DoDot:2
+14 IF PTYP="W"
Begin DoDot:2
+15 FOR AGI=1:1
SET AGJ=$PIECE(VALUE,$CHAR(10),AGI)
IF AGJ=""
QUIT
Begin DoDot:3
+16 SET AGWP(AGI,0)=$$CTRL^AGGUL1(AGJ)
End DoDot:3
End DoDot:2
QUIT
+17 SET @NAME=VALUE
End DoDot:1
IF $GET(BMXSEC)'=""
QUIT
+18 QUIT
