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

AGGPTPVI.m

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