AGGPTPVI ;VNGT/HS/ALA-Private Insurance ; 26 Apr 2010 5:18 PM
;;1.0;PATIENT REGISTRATION GUI;;Nov 15, 2010
;
INIT(DATA,AGGPLIEN) ;EP -- AGG INSUR INITIAL TRIG
NEW UID,II,HDR,SOURCE,VALUE,TYPE,ABLE,CLEAR,HELP
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("AGGPINIT",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(AGGPLIEN)="" S SOURCE="DFNWARN",VALUE="",TYPE="X",ABLE="N",CLEAR="",HELP="" D UP
I $G(AGGPLIEN)'="" D
. I $P($G(^AUPN3PPH(AGGPLIEN,0)),U,2)="" S SOURCE="DFNWARN",VALUE="",TYPE="X",ABLE="Y",CLEAR="",HELP="" D UP Q
. S SOURCE="DFNWARN",VALUE="",TYPE="X",ABLE="N",CLEAR="",HELP="" D UP
S II=II+1,@DATA@(II)=$C(31)
Q
;
EN(DATA,AGGPIHLN) ;EP -- AGG POLICY HOLDER TRIGGER
NEW UID,II,HDR,SOURCE,VALUE,TYPE,ABLE,CLEAR,HELP
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("AGGPHPOL",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 SOURCE="AGGPIHLN",VALUE=AGGPIHLN,TYPE="X",ABLE="Y",CLEAR="AGGPIHSX;AGGPIHDB;AGGPIHDB;AGGPIEMP;AGGPIHAD;AGGPIHCY;AGGPIHST;AGGPIHZP;AGGPIHPH",HELP="" D UP
I $G(AGGPIHLN)'="" D
. I AGGPIHLN'?.N Q
. S SOURCE="AGGPIHLN",VALUE=$P(^AUPN3PPH(AGGPIHLN,0),U,1),TYPE="X",ABLE="Y",CLEAR="AGGPIHSX;AGGPIHDB;AGGPIHDB;AGGPIEMP;AGGPIHAD;AGGPIHCY;AGGPIHST;AGGPIHZP;AGGPIHPH",HELP="" D UP
. S SOURCE="AGGPTDFN",VALUE=$P(^AUPN3PPH(AGGPIHLN,0),U,2),TYPE="N",ABLE="Y",CLEAR="",HELP="" D UP
. S SOURCE="AGGPIHSX",VALUE=$P(^AUPN3PPH(AGGPIHLN,0),U,8),TYPE="C",ABLE="Y",CLEAR="",HELP="" D UP
. S SOURCE="AGGPIHDB",VALUE=$P(^AUPN3PPH(AGGPIHLN,0),U,19),TYPE="D",ABLE="Y",CLEAR="",HELP="" D UP
. S SOURCE="AGGPIHDB",VALUE=$P(^AUPN3PPH(AGGPIHLN,0),U,15),TYPE="C",ABLE="Y",CLEAR="",HELP="" D UP
. S SOURCE="AGGPIEMP",VALUE=$P(^AUPN3PPH(AGGPIHLN,0),U,16),TYPE="T",ABLE="Y",CLEAR="",HELP="" D UP
. S SOURCE="AGGPIHAD",VALUE=$P(^AUPN3PPH(AGGPIHLN,0),U,9),TYPE="X",ABLE="Y",CLEAR="",HELP="" D UP
. S SOURCE="AGGPIHCY",VALUE=$P(^AUPN3PPH(AGGPIHLN,0),U,11),TYPE="X",ABLE="Y",CLEAR="",HELP="" D UP
. S SOURCE="AGGPIHST",VALUE=$P(^AUPN3PPH(AGGPIHLN,0),U,12),TYPE="T",ABLE="Y",CLEAR="",HELP="" D UP
. S SOURCE="AGGPIHZP",VALUE=$P(^AUPN3PPH(AGGPIHLN,0),U,13),TYPE="X",ABLE="Y",CLEAR="",HELP="" D UP
. S SOURCE="AGGPIHPH",VALUE=$P(^AUPN3PPH(AGGPIHLN,0),U,14),TYPE="X",ABLE="Y",CLEAR="",HELP="" D UP
. S SOURCE="AGGPHESD",VALUE=$$FMTE^AGGUL1($P(^AUPN3PPH(AGGPIHLN,0),U,17)),TYPE="D",ABLE="Y",CLEAR="",HELP="" D UP
. S SOURCE="AGGPHEED",VALUE=$$FMTE^AGGUL1($P(^AUPN3PPH(AGGPIHLN,0),U,18)),TYPE="D",ABLE="Y",CLEAR="",HELP="" D UP
. S SOURCE="AGGPINUM",VALUE=$P(^AUPN3PPH(AGGPIHLN,0),U,4),TYPE="X",ABLE="Y",CLEAR="",HELP="" D UP
. S SOURCE="AGGPIHDB",VALUE=$$FMTE^AGGUL1($P(^AUPN3PPH(AGGPIHLN,0),U,19)),TYPE="D",ABLE="Y",CLEAR="",HELP="" D UP
. S SOURCE="AGGPIEMP",VALUE=$P(^AUPN3PPH(AGGPIHLN,0),U,16),TYPE="T",ABLE="Y",CLEAR="",HELP="" D UP
. S SOURCE="AGGPIEMS",VALUE=$P(^AUPN3PPH(AGGPIHLN,0),U,15),TYPE="C",ABLE="Y",CLEAR="",HELP="" D UP
. S SOURCE="AGGPIGRP",VALUE=$P(^AUPN3PPH(AGGPIHLN,0),U,6) I VALUE'="" S VALUE=VALUE_$C(28)_$P($G(^AUTNEGRP(VALUE,0)),U,1)
. S TYPE="T",ABLE="Y",CLEAR="",HELP="" D UP
. S VALUE="",GROUP=$P(^AUPN3PPH(AGGPIHLN,0),U,6) I GROUP'="" S VALUE=$P($G(^AUTNEGRP(GROUP,0)),U,2)
. S SOURCE="AGGPIGRN",TYPE="X",ABLE="Y",CLEAR="",HELP="" D UP
;
S II=II+1,@DATA@(II)=$C(31)
Q
;
SAM(DATA,DFN) ; EP -- AGG POLICY HOLDER SAME TRIG
NEW UID,II,HDR,SOURCE,VALUE,TYPE,ABLE,CLEAR,HELP,CFLAG
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("AGGPHSAME",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 SOURCE="AGGPTDFN",VALUE=DFN,TYPE="N",ABLE="Y",CLEAR="AGGPIHSX;AGGPIHDB;AGGPIHDB;AGGPIEMP;AGGPIHAD;AGGPIHCY;AGGPIHST;AGGPIHZP;AGGPIHPH",HELP="" D UP
S SOURCE="AGGPIHLN",VALUE=$P(^DPT(DFN,0),U,1),TYPE="X",ABLE="Y",CFLAG="",CLEAR="",HELP="" D UP
S SOURCE="AGGPIREL",VALUE=$O(^AUTTRLSH("B","SELF","")),TYPE="T",ABLE="N",CFLAG="N",CLEAR="",HELP="" D UP
S SOURCE="AGGPIHSX",VALUE=$P(^DPT(DFN,0),U,2),TYPE="C",ABLE="Y",CFLAG="",CLEAR="",HELP="" D UP
S SOURCE="AGGPIHDB",VALUE=$$FMTE^AGGUL1($P(^DPT(DFN,0),U,3)),TYPE="D",ABLE="Y",CFLAG="",CLEAR="",HELP="" D UP
S SOURCE="AGGPIEMS",VALUE=$$GET1^DIQ(9000001,DFN_",",.21,"I"),TYPE="C",ABLE="Y",CFLAG="",CLEAR="",HELP="" D UP
S SOURCE="AGGPIEMP",VALUE=$$GET1^DIQ(9000001,DFN_",",.19,"I"),TYPE="T",ABLE="Y",CFLAG="",CLEAR="",HELP="" D UP
S SOURCE="AGGPIHAD",VALUE=$$GET1^DIQ(2,DFN_",",.111,"E"),TYPE="X",ABLE="Y",CFLAG="",CLEAR="",HELP="" D UP
S SOURCE="AGGPIHCY",VALUE=$$GET1^DIQ(2,DFN_",",.114,"E"),TYPE="X",ABLE="Y",CFLAG="",CLEAR="",HELP="" D UP
S SOURCE="AGGPIHST",VALUE=$$GET1^DIQ(2,DFN_",",.115,"I"),TYPE="T",ABLE="Y",CFLAG="",CLEAR="",HELP="" D UP
S SOURCE="AGGPIHZP",VALUE=$S($$GET1^DIQ(2,DFN_",",.1112,"E")'="":$$GET1^DIQ(2,DFN_",",.1112,"E"),1:$$GET1^DIQ(2,DFN_",",.116,"E")),TYPE="X",ABLE="Y",CFLAG="",CLEAR="",HELP="" D UP
S SOURCE="AGGPIHPH",VALUE=$$GET1^DIQ(2,DFN_",",.131,"E"),TYPE="X",ABLE="Y",CFLAG="",CLEAR="",HELP="" D UP
S II=II+1,@DATA@(II)=$C(31)
Q
;
PTN(DATA,AGGPTDFN) ; EP -- AGG POLICY HOLDER PAT TRIG
NEW UID,II,HDR,SOURCE,VALUE,TYPE,ABLE,CLEAR,HELP
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("AGGPHPAT",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(AGGPTDFN)'="" D
. S SOURCE="AGGPIHLN",VALUE=$P(^DPT(AGGPTDFN,0),U,1),TYPE="X",ABLE="Y",CLEAR="AGGPIHSX;AGGPIHDB;AGGPIHDB;AGGPIEMP;AGGPIHAD;AGGPIHCY;AGGPIHST;AGGPIHZP;AGGPIHPH",HELP="" D UP
. S SOURCE="AGGPIHSX",VALUE=$P(^DPT(AGGPTDFN,0),U,2),TYPE="C",ABLE="Y",CLEAR="",HELP="" D UP
. S SOURCE="AGGPIHDB",VALUE=$$FMTE^AGGUL1($P(^DPT(AGGPTDFN,0),U,3)),TYPE="D",ABLE="Y",CLEAR="",HELP="" D UP
. S SOURCE="AGGPIEMS",VALUE=$$GET1^DIQ(9000001,AGGPTDFN_",",.21,"I"),TYPE="C",ABLE="Y",CLEAR="",HELP="" D UP
. S SOURCE="AGGPIEMP",VALUE=$$GET1^DIQ(9000001,AGGPTDFN_",",.19,"I"),TYPE="T",ABLE="Y",CLEAR="",HELP="" D UP
. S SOURCE="AGGPIHAD",VALUE=$$GET1^DIQ(2,AGGPTDFN_",",.111,"E"),TYPE="X",ABLE="Y",CLEAR="",HELP="" D UP
. S SOURCE="AGGPIHCY",VALUE=$$GET1^DIQ(2,AGGPTDFN_",",.114,"E"),TYPE="X",ABLE="Y",CLEAR="",HELP="" D UP
. S SOURCE="AGGPIHST",VALUE=$$GET1^DIQ(2,AGGPTDFN_",",.115,"I"),TYPE="T",ABLE="Y",CLEAR="",HELP="" D UP
. S SOURCE="AGGPIHZP",VALUE=$S($$GET1^DIQ(2,AGGPTDFN_",",.1112,"E")'="":$$GET1^DIQ(2,AGGPTDFN_",",.1112,"E"),1:$$GET1^DIQ(2,AGGPTDFN_",",.116,"E")),TYPE="X",ABLE="Y",CLEAR="",HELP="" D UP
. S SOURCE="AGGPIHPH",VALUE=$$GET1^DIQ(2,AGGPTDFN_",",.131,"E"),TYPE="X",ABLE="Y",CLEAR="",HELP="" D UP
;
S II=II+1,@DATA@(II)=$C(31)
Q
;
HDR ;
S HDR="T00008SOURCE^T00001CODE_TYPE^T01024PARMS^T00001ABLE_FLAG^T00001CLEAR_FLAG^T00100CLEAR_FIELDS^T00200HELP_TEXT"
Q
;
UP ;
S II=II+1,@DATA@(II)=SOURCE_U_TYPE_U_VALUE_U_ABLE_U_$G(CFLAG)_U_$G(CLEAR)_U_HELP_$C(30)
Q
;
POL(LDATA,VALUE,INSRUR) ;EP -- AGG POLICY HOLDER LOOKUP
; Lookup policy holder by name (VALUE) and selected insurer (INSRUR)
NEW UID,II,AGN,PIEN,EXP
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S LDATA=$NA(^TMP("AGGPOLH",UID)) K @LDATA
S SCREEN="I $P(^(0),U,3)="_INSRUR,FNBR=9000003.1
D LKP^AGGWTBLK(.LDATA,FNBR,VALUE,SCREEN)
S LG=$L(@LDATA@(0)),ECHR=$E(@LDATA@(0),LG,LG) I $C(ECHR)'=30 S @LDATA@(0)=@LDATA@(0)_$C(30)
S AGN=0
F S AGN=$O(@LDATA@(AGN)) Q:'AGN D
. S PIEN=$P(@LDATA@(AGN),U,1)
. S EXP=$P($G(^AUPN3PPH(PIEN,0)),U,18) I EXP="" Q
. I EXP>DT Q
. K @LDATA@(AGN)
Q
;
PAT(LDATA,VALUE) ;EP -- AGG POLICY HOLDER PATIENT
NEW UID,II
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S LDATA=$NA(^TMP("AGGPOLHP",UID)) K @LDATA
D FND^AGGPTLKP(.LDATA,VALUE,"N","")
S $P(@LDATA@(0),U,1)="I00010AGGPTDFN",$P(@LDATA@(0),U,2)="T00035AGGPIHLN"
Q
;
INS(DATA,VALUE) ; EP -- AGG LOOKUP INSURANCE
NEW UID,II,X,DDATA,FNBR,LPC
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("AGGINSLK",UID))
K @DATA
;
S II=0
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^AGGPTPVI D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
;
S FNBR=9999999.18,VALUE=$G(VALUE,"")
;
NEW FILE,FIELD,INDEX,FLAGS,NUMB,JJ,IEN,TEXT,DESC,AGTYPE,WINDOW
NEW MAP,HDR,MII,NFLD,TYPE,ERROR,XTLKUT,SCREEN
S FILE=FNBR,NUMB="*",INDEX=""
S SCREEN="I $P($G(^(1)),U,7)'=0"
S FIELD="FID;.02;.03",INDEX="B",FLAGS="P"
;
D FIND^DIC(FILE,"",FIELD,FLAGS,VALUE,"",INDEX,SCREEN,"","","ERROR")
;
I $D(ERROR)>0 S BMXSEC="RPC Call Failed: "_$G(ERROR("DIERR",1,"TEXT",1)) Q
;
S DDATA=$NA(^TMP("DILIST",UID))
S MAP=$G(@DDATA@(0,"MAP"))
I MAP'="" D
. S HDR=""
. F MII=1:1:$L(MAP,"^") D
.. I $P(MAP,"^",MII)="IEN" S HDR=HDR_"T00015IEN^" Q
.. I $P(MAP,"^",MII)[".01" D CHK(.01) S HDR=HDR_TYPE_"^" Q
.. S NFLD=$P(MAP,"^",MII)
.. I NFLD["FID(" S NFLD=$P($P(NFLD,"FID(",2),")",1) D CHK(NFLD) S HDR=HDR_TYPE_"^" Q
.. D CHK(NFLD) S HDR=HDR_TYPE_"^"
. S HDR=HDR_"T00025TYPE_OF_INSURER^T00040HIDE_WINDOW"
. S HDR=$$TKO^AGGUL1(HDR,"^"),HDR=$TR(HDR," ","_")
. S @DATA@(II)=HDR_$C(30)
;
S JJ=0
F S JJ=$O(@DDATA@(JJ)) Q:'JJ D
. I MAP'="" D
.. NEW IEN,TEXT,DESC,QFL
.. S IEN=$P(@DDATA@(JJ,0),U,1),QFL=0
.. S TEXT=$P(@DDATA@(JJ,0),U,2)
.. I TEXT?.N D
... S DESC=$$GET1^DIQ(FNBR,IEN,.01,"E")
... S $P(@DDATA@(JJ,0),U,2)=DESC
.. S AGTYPE=$$GET1^DIQ(FNBR,$P(@DDATA@(JJ,0),U,1)_",",.21,"I")
.. S WINDOW=""
.. I AGTYPE="MD" S WINDOW="Medicare"
.. I AGTYPE="R",TEXT'="RAILROAD RETIREMENT" S WINDOW="Medicare"
.. I AGTYPE="R",TEXT="RAILROAD RETIREMENT" S WINDOW="Railroad"
.. I AGTYPE="D"!(AGTYPE="K") S WINDOW="Medicaid"
.. I AGTYPE="W" S WINDOW="Workers Comp"
.. I AGTYPE="T" S WINDOW="Private Insurance"
.. I AGTYPE="G" S WINDOW="Guarantor"
.. I WINDOW="" S WINDOW="Private Insurance"
.. S LPC=$L(@DDATA@(JJ,0),"^")+1,$P(@DDATA@(JJ,0),U,LPC)=AGTYPE_U_WINDOW
.. S II=II+1,@DATA@(II)=@DDATA@(JJ,0)_$C(30)
;
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
;
CHK(BFLD) ;EP - Check for definition of a field
NEW DLEN
D FIELD^DID(FNBR,BFLD,"","TYPE","BQX")
D FIELD^DID(FNBR,BFLD,"","FIELD LENGTH","BQX")
D FIELD^DID(FNBR,BFLD,"","LABEL","BQX")
S TYPE=$S(BQX("TYPE")["DATE":"D",1:"T")
S DLEN=BQX("FIELD LENGTH")+5
S TYPE=TYPE_$E("00000",$L(DLEN)+1,5)_DLEN_BQX("LABEL")
K BQX
Q
;
COV(DATA,AGGPIINS) ;EP - AGG INSUR COV TRIGGER
NEW UID,II,HDR,SOURCE,VALUE,TYPE,ABLE,CLEAR,HELP
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("AGGINSCV",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 SOURCE="AGGPICOV",VALUE="",TYPE="T",ABLE="Y",CLEAR="",HELP=""
I $O(^AUTTPIC("C",AGGPIINS,""))="" S HELP="No coverage types found for this Insurer" D UP
I $O(^AUTTPIC("C",AGGPIINS,""))'="" D
. S IEN="",VALUE=""
. F S IEN=$O(^AUTTPIC("C",AGGPIINS,IEN)) Q:IEN="" D
.. S VALUE=VALUE_IEN_$C(29)_$P(^AUTTPIC(IEN,0),U,1)_$C(28)
. D UP
S II=II+1,@DATA@(II)=$C(31)
Q
AGGPTPVI ;VNGT/HS/ALA-Private Insurance ; 26 Apr 2010 5:18 PM
+1 ;;1.0;PATIENT REGISTRATION GUI;;Nov 15, 2010
+2 ;
INIT(DATA,AGGPLIEN) ;EP -- AGG INSUR INITIAL TRIG
+1 NEW UID,II,HDR,SOURCE,VALUE,TYPE,ABLE,CLEAR,HELP
+2 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+3 SET DATA=$NAME(^TMP("AGGPINIT",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 ;
+8 DO HDR
+9 SET @DATA@(II)=HDR_$CHAR(30)
+10 IF $GET(AGGPLIEN)=""
SET SOURCE="DFNWARN"
SET VALUE=""
SET TYPE="X"
SET ABLE="N"
SET CLEAR=""
SET HELP=""
DO UP
+11 IF $GET(AGGPLIEN)'=""
Begin DoDot:1
+12 IF $PIECE($GET(^AUPN3PPH(AGGPLIEN,0)),U,2)=""
SET SOURCE="DFNWARN"
SET VALUE=""
SET TYPE="X"
SET ABLE="Y"
SET CLEAR=""
SET HELP=""
DO UP
QUIT
+13 SET SOURCE="DFNWARN"
SET VALUE=""
SET TYPE="X"
SET ABLE="N"
SET CLEAR=""
SET HELP=""
DO UP
End DoDot:1
+14 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+15 QUIT
+16 ;
EN(DATA,AGGPIHLN) ;EP -- AGG POLICY HOLDER TRIGGER
+1 NEW UID,II,HDR,SOURCE,VALUE,TYPE,ABLE,CLEAR,HELP
+2 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+3 SET DATA=$NAME(^TMP("AGGPHPOL",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 ;
+8 DO HDR
+9 SET @DATA@(II)=HDR_$CHAR(30)
+10 ;S SOURCE="AGGPIHLN",VALUE=AGGPIHLN,TYPE="X",ABLE="Y",CLEAR="AGGPIHSX;AGGPIHDB;AGGPIHDB;AGGPIEMP;AGGPIHAD;AGGPIHCY;AGGPIHST;AGGPIHZP;AGGPIHPH",HELP="" D UP
+11 IF $GET(AGGPIHLN)'=""
Begin DoDot:1
+12 IF AGGPIHLN'?.N
QUIT
+13 SET SOURCE="AGGPIHLN"
SET VALUE=$PIECE(^AUPN3PPH(AGGPIHLN,0),U,1)
SET TYPE="X"
SET ABLE="Y"
SET CLEAR="AGGPIHSX;AGGPIHDB;AGGPIHDB;AGGPIEMP;AGGPIHAD;AGGPIHCY;AGGPIHST;AGGPIHZP;AGGPIHPH"
SET HELP=""
DO UP
+14 SET SOURCE="AGGPTDFN"
SET VALUE=$PIECE(^AUPN3PPH(AGGPIHLN,0),U,2)
SET TYPE="N"
SET ABLE="Y"
SET CLEAR=""
SET HELP=""
DO UP
+15 SET SOURCE="AGGPIHSX"
SET VALUE=$PIECE(^AUPN3PPH(AGGPIHLN,0),U,8)
SET TYPE="C"
SET ABLE="Y"
SET CLEAR=""
SET HELP=""
DO UP
+16 SET SOURCE="AGGPIHDB"
SET VALUE=$PIECE(^AUPN3PPH(AGGPIHLN,0),U,19)
SET TYPE="D"
SET ABLE="Y"
SET CLEAR=""
SET HELP=""
DO UP
+17 SET SOURCE="AGGPIHDB"
SET VALUE=$PIECE(^AUPN3PPH(AGGPIHLN,0),U,15)
SET TYPE="C"
SET ABLE="Y"
SET CLEAR=""
SET HELP=""
DO UP
+18 SET SOURCE="AGGPIEMP"
SET VALUE=$PIECE(^AUPN3PPH(AGGPIHLN,0),U,16)
SET TYPE="T"
SET ABLE="Y"
SET CLEAR=""
SET HELP=""
DO UP
+19 SET SOURCE="AGGPIHAD"
SET VALUE=$PIECE(^AUPN3PPH(AGGPIHLN,0),U,9)
SET TYPE="X"
SET ABLE="Y"
SET CLEAR=""
SET HELP=""
DO UP
+20 SET SOURCE="AGGPIHCY"
SET VALUE=$PIECE(^AUPN3PPH(AGGPIHLN,0),U,11)
SET TYPE="X"
SET ABLE="Y"
SET CLEAR=""
SET HELP=""
DO UP
+21 SET SOURCE="AGGPIHST"
SET VALUE=$PIECE(^AUPN3PPH(AGGPIHLN,0),U,12)
SET TYPE="T"
SET ABLE="Y"
SET CLEAR=""
SET HELP=""
DO UP
+22 SET SOURCE="AGGPIHZP"
SET VALUE=$PIECE(^AUPN3PPH(AGGPIHLN,0),U,13)
SET TYPE="X"
SET ABLE="Y"
SET CLEAR=""
SET HELP=""
DO UP
+23 SET SOURCE="AGGPIHPH"
SET VALUE=$PIECE(^AUPN3PPH(AGGPIHLN,0),U,14)
SET TYPE="X"
SET ABLE="Y"
SET CLEAR=""
SET HELP=""
DO UP
+24 SET SOURCE="AGGPHESD"
SET VALUE=$$FMTE^AGGUL1($PIECE(^AUPN3PPH(AGGPIHLN,0),U,17))
SET TYPE="D"
SET ABLE="Y"
SET CLEAR=""
SET HELP=""
DO UP
+25 SET SOURCE="AGGPHEED"
SET VALUE=$$FMTE^AGGUL1($PIECE(^AUPN3PPH(AGGPIHLN,0),U,18))
SET TYPE="D"
SET ABLE="Y"
SET CLEAR=""
SET HELP=""
DO UP
+26 SET SOURCE="AGGPINUM"
SET VALUE=$PIECE(^AUPN3PPH(AGGPIHLN,0),U,4)
SET TYPE="X"
SET ABLE="Y"
SET CLEAR=""
SET HELP=""
DO UP
+27 SET SOURCE="AGGPIHDB"
SET VALUE=$$FMTE^AGGUL1($PIECE(^AUPN3PPH(AGGPIHLN,0),U,19))
SET TYPE="D"
SET ABLE="Y"
SET CLEAR=""
SET HELP=""
DO UP
+28 SET SOURCE="AGGPIEMP"
SET VALUE=$PIECE(^AUPN3PPH(AGGPIHLN,0),U,16)
SET TYPE="T"
SET ABLE="Y"
SET CLEAR=""
SET HELP=""
DO UP
+29 SET SOURCE="AGGPIEMS"
SET VALUE=$PIECE(^AUPN3PPH(AGGPIHLN,0),U,15)
SET TYPE="C"
SET ABLE="Y"
SET CLEAR=""
SET HELP=""
DO UP
+30 SET SOURCE="AGGPIGRP"
SET VALUE=$PIECE(^AUPN3PPH(AGGPIHLN,0),U,6)
IF VALUE'=""
SET VALUE=VALUE_$CHAR(28)_$PIECE($GET(^AUTNEGRP(VALUE,0)),U,1)
+31 SET TYPE="T"
SET ABLE="Y"
SET CLEAR=""
SET HELP=""
DO UP
+32 SET VALUE=""
SET GROUP=$PIECE(^AUPN3PPH(AGGPIHLN,0),U,6)
IF GROUP'=""
SET VALUE=$PIECE($GET(^AUTNEGRP(GROUP,0)),U,2)
+33 SET SOURCE="AGGPIGRN"
SET TYPE="X"
SET ABLE="Y"
SET CLEAR=""
SET HELP=""
DO UP
End DoDot:1
+34 ;
+35 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+36 QUIT
+37 ;
SAM(DATA,DFN) ; EP -- AGG POLICY HOLDER SAME TRIG
+1 NEW UID,II,HDR,SOURCE,VALUE,TYPE,ABLE,CLEAR,HELP,CFLAG
+2 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+3 SET DATA=$NAME(^TMP("AGGPHSAME",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 ;
+8 DO HDR
+9 SET @DATA@(II)=HDR_$CHAR(30)
+10 SET SOURCE="AGGPTDFN"
SET VALUE=DFN
SET TYPE="N"
SET ABLE="Y"
SET CLEAR="AGGPIHSX;AGGPIHDB;AGGPIHDB;AGGPIEMP;AGGPIHAD;AGGPIHCY;AGGPIHST;AGGPIHZP;AGGPIHPH"
SET HELP=""
DO UP
+11 SET SOURCE="AGGPIHLN"
SET VALUE=$PIECE(^DPT(DFN,0),U,1)
SET TYPE="X"
SET ABLE="Y"
SET CFLAG=""
SET CLEAR=""
SET HELP=""
DO UP
+12 SET SOURCE="AGGPIREL"
SET VALUE=$ORDER(^AUTTRLSH("B","SELF",""))
SET TYPE="T"
SET ABLE="N"
SET CFLAG="N"
SET CLEAR=""
SET HELP=""
DO UP
+13 SET SOURCE="AGGPIHSX"
SET VALUE=$PIECE(^DPT(DFN,0),U,2)
SET TYPE="C"
SET ABLE="Y"
SET CFLAG=""
SET CLEAR=""
SET HELP=""
DO UP
+14 SET SOURCE="AGGPIHDB"
SET VALUE=$$FMTE^AGGUL1($PIECE(^DPT(DFN,0),U,3))
SET TYPE="D"
SET ABLE="Y"
SET CFLAG=""
SET CLEAR=""
SET HELP=""
DO UP
+15 SET SOURCE="AGGPIEMS"
SET VALUE=$$GET1^DIQ(9000001,DFN_",",.21,"I")
SET TYPE="C"
SET ABLE="Y"
SET CFLAG=""
SET CLEAR=""
SET HELP=""
DO UP
+16 SET SOURCE="AGGPIEMP"
SET VALUE=$$GET1^DIQ(9000001,DFN_",",.19,"I")
SET TYPE="T"
SET ABLE="Y"
SET CFLAG=""
SET CLEAR=""
SET HELP=""
DO UP
+17 SET SOURCE="AGGPIHAD"
SET VALUE=$$GET1^DIQ(2,DFN_",",.111,"E")
SET TYPE="X"
SET ABLE="Y"
SET CFLAG=""
SET CLEAR=""
SET HELP=""
DO UP
+18 SET SOURCE="AGGPIHCY"
SET VALUE=$$GET1^DIQ(2,DFN_",",.114,"E")
SET TYPE="X"
SET ABLE="Y"
SET CFLAG=""
SET CLEAR=""
SET HELP=""
DO UP
+19 SET SOURCE="AGGPIHST"
SET VALUE=$$GET1^DIQ(2,DFN_",",.115,"I")
SET TYPE="T"
SET ABLE="Y"
SET CFLAG=""
SET CLEAR=""
SET HELP=""
DO UP
+20 SET SOURCE="AGGPIHZP"
SET VALUE=$SELECT($$GET1^DIQ(2,DFN_",",.1112,"E")'="":$$GET1^DIQ(2,DFN_",",.1112,"E"),1:$$GET1^DIQ(2,DFN_",",.116,"E"))
SET TYPE="X"
SET ABLE="Y"
SET CFLAG=""
SET CLEAR=""
SET HELP=""
DO UP
+21 SET SOURCE="AGGPIHPH"
SET VALUE=$$GET1^DIQ(2,DFN_",",.131,"E")
SET TYPE="X"
SET ABLE="Y"
SET CFLAG=""
SET CLEAR=""
SET HELP=""
DO UP
+22 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+23 QUIT
+24 ;
PTN(DATA,AGGPTDFN) ; EP -- AGG POLICY HOLDER PAT TRIG
+1 NEW UID,II,HDR,SOURCE,VALUE,TYPE,ABLE,CLEAR,HELP
+2 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+3 SET DATA=$NAME(^TMP("AGGPHPAT",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 ;
+8 DO HDR
+9 SET @DATA@(II)=HDR_$CHAR(30)
+10 IF $GET(AGGPTDFN)'=""
Begin DoDot:1
+11 SET SOURCE="AGGPIHLN"
SET VALUE=$PIECE(^DPT(AGGPTDFN,0),U,1)
SET TYPE="X"
SET ABLE="Y"
SET CLEAR="AGGPIHSX;AGGPIHDB;AGGPIHDB;AGGPIEMP;AGGPIHAD;AGGPIHCY;AGGPIHST;AGGPIHZP;AGGPIHPH"
SET HELP=""
DO UP
+12 SET SOURCE="AGGPIHSX"
SET VALUE=$PIECE(^DPT(AGGPTDFN,0),U,2)
SET TYPE="C"
SET ABLE="Y"
SET CLEAR=""
SET HELP=""
DO UP
+13 SET SOURCE="AGGPIHDB"
SET VALUE=$$FMTE^AGGUL1($PIECE(^DPT(AGGPTDFN,0),U,3))
SET TYPE="D"
SET ABLE="Y"
SET CLEAR=""
SET HELP=""
DO UP
+14 SET SOURCE="AGGPIEMS"
SET VALUE=$$GET1^DIQ(9000001,AGGPTDFN_",",.21,"I")
SET TYPE="C"
SET ABLE="Y"
SET CLEAR=""
SET HELP=""
DO UP
+15 SET SOURCE="AGGPIEMP"
SET VALUE=$$GET1^DIQ(9000001,AGGPTDFN_",",.19,"I")
SET TYPE="T"
SET ABLE="Y"
SET CLEAR=""
SET HELP=""
DO UP
+16 SET SOURCE="AGGPIHAD"
SET VALUE=$$GET1^DIQ(2,AGGPTDFN_",",.111,"E")
SET TYPE="X"
SET ABLE="Y"
SET CLEAR=""
SET HELP=""
DO UP
+17 SET SOURCE="AGGPIHCY"
SET VALUE=$$GET1^DIQ(2,AGGPTDFN_",",.114,"E")
SET TYPE="X"
SET ABLE="Y"
SET CLEAR=""
SET HELP=""
DO UP
+18 SET SOURCE="AGGPIHST"
SET VALUE=$$GET1^DIQ(2,AGGPTDFN_",",.115,"I")
SET TYPE="T"
SET ABLE="Y"
SET CLEAR=""
SET HELP=""
DO UP
+19 SET SOURCE="AGGPIHZP"
SET VALUE=$SELECT($$GET1^DIQ(2,AGGPTDFN_",",.1112,"E")'="":$$GET1^DIQ(2,AGGPTDFN_",",.1112,"E"),1:$$GET1^DIQ(2,AGGPTDFN_",",.116,"E"))
SET TYPE="X"
SET ABLE="Y"
SET CLEAR=""
SET HELP=""
DO UP
+20 SET SOURCE="AGGPIHPH"
SET VALUE=$$GET1^DIQ(2,AGGPTDFN_",",.131,"E")
SET TYPE="X"
SET ABLE="Y"
SET CLEAR=""
SET HELP=""
DO UP
End DoDot:1
+21 ;
+22 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+23 QUIT
+24 ;
HDR ;
+1 SET HDR="T00008SOURCE^T00001CODE_TYPE^T01024PARMS^T00001ABLE_FLAG^T00001CLEAR_FLAG^T00100CLEAR_FIELDS^T00200HELP_TEXT"
+2 QUIT
+3 ;
UP ;
+1 SET II=II+1
SET @DATA@(II)=SOURCE_U_TYPE_U_VALUE_U_ABLE_U_$GET(CFLAG)_U_$GET(CLEAR)_U_HELP_$CHAR(30)
+2 QUIT
+3 ;
POL(LDATA,VALUE,INSRUR) ;EP -- AGG POLICY HOLDER LOOKUP
+1 ; Lookup policy holder by name (VALUE) and selected insurer (INSRUR)
+2 NEW UID,II,AGN,PIEN,EXP
+3 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+4 SET LDATA=$NAME(^TMP("AGGPOLH",UID))
KILL @LDATA
+5 SET SCREEN="I $P(^(0),U,3)="_INSRUR
SET FNBR=9000003.1
+6 DO LKP^AGGWTBLK(.LDATA,FNBR,VALUE,SCREEN)
+7 SET LG=$LENGTH(@LDATA@(0))
SET ECHR=$EXTRACT(@LDATA@(0),LG,LG)
IF $CHAR(ECHR)'=30
SET @LDATA@(0)=@LDATA@(0)_$CHAR(30)
+8 SET AGN=0
+9 FOR
SET AGN=$ORDER(@LDATA@(AGN))
IF 'AGN
QUIT
Begin DoDot:1
+10 SET PIEN=$PIECE(@LDATA@(AGN),U,1)
+11 SET EXP=$PIECE($GET(^AUPN3PPH(PIEN,0)),U,18)
IF EXP=""
QUIT
+12 IF EXP>DT
QUIT
+13 KILL @LDATA@(AGN)
End DoDot:1
+14 QUIT
+15 ;
PAT(LDATA,VALUE) ;EP -- AGG POLICY HOLDER PATIENT
+1 NEW UID,II
+2 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+3 SET LDATA=$NAME(^TMP("AGGPOLHP",UID))
KILL @LDATA
+4 DO FND^AGGPTLKP(.LDATA,VALUE,"N","")
+5 SET $PIECE(@LDATA@(0),U,1)="I00010AGGPTDFN"
SET $PIECE(@LDATA@(0),U,2)="T00035AGGPIHLN"
+6 QUIT
+7 ;
INS(DATA,VALUE) ; EP -- AGG LOOKUP INSURANCE
+1 NEW UID,II,X,DDATA,FNBR,LPC
+2 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+3 SET DATA=$NAME(^TMP("AGGINSLK",UID))
+4 KILL @DATA
+5 ;
+6 SET II=0
+7 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^AGGPTPVI D UNWIND^%ZTER"
+8 ;
+9 SET FNBR=9999999.18
SET VALUE=$GET(VALUE,"")
+10 ;
+11 NEW FILE,FIELD,INDEX,FLAGS,NUMB,JJ,IEN,TEXT,DESC,AGTYPE,WINDOW
+12 NEW MAP,HDR,MII,NFLD,TYPE,ERROR,XTLKUT,SCREEN
+13 SET FILE=FNBR
SET NUMB="*"
SET INDEX=""
+14 SET SCREEN="I $P($G(^(1)),U,7)'=0"
+15 SET FIELD="FID;.02;.03"
SET INDEX="B"
SET FLAGS="P"
+16 ;
+17 DO FIND^DIC(FILE,"",FIELD,FLAGS,VALUE,"",INDEX,SCREEN,"","","ERROR")
+18 ;
+19 IF $DATA(ERROR)>0
SET BMXSEC="RPC Call Failed: "_$GET(ERROR("DIERR",1,"TEXT",1))
QUIT
+20 ;
+21 SET DDATA=$NAME(^TMP("DILIST",UID))
+22 SET MAP=$GET(@DDATA@(0,"MAP"))
+23 IF MAP'=""
Begin DoDot:1
+24 SET HDR=""
+25 FOR MII=1:1:$LENGTH(MAP,"^")
Begin DoDot:2
+26 IF $PIECE(MAP,"^",MII)="IEN"
SET HDR=HDR_"T00015IEN^"
QUIT
+27 IF $PIECE(MAP,"^",MII)[".01"
DO CHK(.01)
SET HDR=HDR_TYPE_"^"
QUIT
+28 SET NFLD=$PIECE(MAP,"^",MII)
+29 IF NFLD["FID("
SET NFLD=$PIECE($PIECE(NFLD,"FID(",2),")",1)
DO CHK(NFLD)
SET HDR=HDR_TYPE_"^"
QUIT
+30 DO CHK(NFLD)
SET HDR=HDR_TYPE_"^"
End DoDot:2
+31 SET HDR=HDR_"T00025TYPE_OF_INSURER^T00040HIDE_WINDOW"
+32 SET HDR=$$TKO^AGGUL1(HDR,"^")
SET HDR=$TRANSLATE(HDR," ","_")
+33 SET @DATA@(II)=HDR_$CHAR(30)
End DoDot:1
+34 ;
+35 SET JJ=0
+36 FOR
SET JJ=$ORDER(@DDATA@(JJ))
IF 'JJ
QUIT
Begin DoDot:1
+37 IF MAP'=""
Begin DoDot:2
+38 NEW IEN,TEXT,DESC,QFL
+39 SET IEN=$PIECE(@DDATA@(JJ,0),U,1)
SET QFL=0
+40 SET TEXT=$PIECE(@DDATA@(JJ,0),U,2)
+41 IF TEXT?.N
Begin DoDot:3
+42 SET DESC=$$GET1^DIQ(FNBR,IEN,.01,"E")
+43 SET $PIECE(@DDATA@(JJ,0),U,2)=DESC
End DoDot:3
+44 SET AGTYPE=$$GET1^DIQ(FNBR,$PIECE(@DDATA@(JJ,0),U,1)_",",.21,"I")
+45 SET WINDOW=""
+46 IF AGTYPE="MD"
SET WINDOW="Medicare"
+47 IF AGTYPE="R"
IF TEXT'="RAILROAD RETIREMENT"
SET WINDOW="Medicare"
+48 IF AGTYPE="R"
IF TEXT="RAILROAD RETIREMENT"
SET WINDOW="Railroad"
+49 IF AGTYPE="D"!(AGTYPE="K")
SET WINDOW="Medicaid"
+50 IF AGTYPE="W"
SET WINDOW="Workers Comp"
+51 IF AGTYPE="T"
SET WINDOW="Private Insurance"
+52 IF AGTYPE="G"
SET WINDOW="Guarantor"
+53 IF WINDOW=""
SET WINDOW="Private Insurance"
+54 SET LPC=$LENGTH(@DDATA@(JJ,0),"^")+1
SET $PIECE(@DDATA@(JJ,0),U,LPC)=AGTYPE_U_WINDOW
+55 SET II=II+1
SET @DATA@(II)=@DDATA@(JJ,0)_$CHAR(30)
End DoDot:2
End DoDot:1
+56 ;
+57 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+58 QUIT
+59 ;
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 ;
CHK(BFLD) ;EP - Check for definition of a field
+1 NEW DLEN
+2 DO FIELD^DID(FNBR,BFLD,"","TYPE","BQX")
+3 DO FIELD^DID(FNBR,BFLD,"","FIELD LENGTH","BQX")
+4 DO FIELD^DID(FNBR,BFLD,"","LABEL","BQX")
+5 SET TYPE=$SELECT(BQX("TYPE")["DATE":"D",1:"T")
+6 SET DLEN=BQX("FIELD LENGTH")+5
+7 SET TYPE=TYPE_$EXTRACT("00000",$LENGTH(DLEN)+1,5)_DLEN_BQX("LABEL")
+8 KILL BQX
+9 QUIT
+10 ;
COV(DATA,AGGPIINS) ;EP - AGG INSUR COV TRIGGER
+1 NEW UID,II,HDR,SOURCE,VALUE,TYPE,ABLE,CLEAR,HELP
+2 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+3 SET DATA=$NAME(^TMP("AGGINSCV",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 ;
+8 DO HDR
+9 SET @DATA@(II)=HDR_$CHAR(30)
+10 SET SOURCE="AGGPICOV"
SET VALUE=""
SET TYPE="T"
SET ABLE="Y"
SET CLEAR=""
SET HELP=""
+11 IF $ORDER(^AUTTPIC("C",AGGPIINS,""))=""
SET HELP="No coverage types found for this Insurer"
DO UP
+12 IF $ORDER(^AUTTPIC("C",AGGPIINS,""))'=""
Begin DoDot:1
+13 SET IEN=""
SET VALUE=""
+14 FOR
SET IEN=$ORDER(^AUTTPIC("C",AGGPIINS,IEN))
IF IEN=""
QUIT
Begin DoDot:2
+15 SET VALUE=VALUE_IEN_$CHAR(29)_$PIECE(^AUTTPIC(IEN,0),U,1)_$CHAR(28)
End DoDot:2
+16 DO UP
End DoDot:1
+17 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+18 QUIT
