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

AGGWTRIG.m

Go to the documentation of this file. 
  1. AGGWTRIG ;VNGT/HS/ALA - Window Triggers ; 07 Apr 2010  7:09 PM
  1.  ;;1.0;PATIENT REGISTRATION GUI;;Nov 15, 2010
  1.  ;
  1. FORM(LNM,FNM,MNM) ;EP - Format Name
  1.  NEW NAME
  1.  S NAME=LNM_","_FNM_" "_MNM
  1.  K DG20NAME S DG20NAME=X,(X,DG20NAME)=$$FORMAT^DPTNAME(.DG20NAME,3,30)
  1.  K:'$L(X) X,DG20NAME S:$D(X) DGNEWVAL=X
  1.  Q
  1.  ;
  1. HDR ;
  1.  S HDR="T00008SOURCE^T00001CODE_TYPE^T01024PARMS^T00001ABLE_FLAG^T00100CLEAR_FIELDS^T00200HELP_TEXT^T00001VISIBLE"
  1.  Q
  1.  ;
  1. VET(DATA,DFN,AGGPTVET) ; EP -- AGG VETERAN TRIGGER
  1.  ; Input
  1.  ;   DFN      - Patient IEN
  1.  ;   AGGPTVET - Value of VETERAN (Y/N)?
  1.  ;
  1.  NEW UID,II,VALUE,SOURCE,IEN,HELP,TYPE,ABLE,AGE,VISIBLE
  1.  S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1.  S DATA=$NA(^TMP("AGGTRVET",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.  D HDR
  1.  S @DATA@(II)=HDR_$C(30)
  1.  S AGGPTVET=$G(AGGPTVET)
  1.  I AGGPTVET="" S AGGPTVET=$$GET1^DIQ(2,DFN_",",1901,"I")
  1.  S AGE=$$AGE^AGGAGE(DFN) I AGE<17 S AGGPTVET="N"
  1.  S SOURCE="AGGPTVET"
  1.  F  S SOURCE=$O(^AGG(9009068.3,5,10,"AC",SOURCE)) Q:SOURCE=""  D
  1.  . S IEN=""
  1.  . F  S IEN=$O(^AGG(9009068.3,5,10,"AC",SOURCE,IEN)) Q:IEN=""  D
  1.  .. S HELP="",VALUE="",TYPE=$P($G(^AGG(9009068.3,5,10,IEN,1)),U,1)
  1.  .. S ABLE=$S(AGGPTVET="Y":"Y",1:"N") I ABLE="N" S CLEAR=SOURCE
  1.  .. D UP
  1.  ;
  1.  S II=II+1,@DATA@(II)=$C(31)
  1.  Q
  1.  ;
  1. CLM(DATA,DFN,AGGVCLMN) ; EP - AGG VET CLAIM TRIGGER
  1.  NEW UID,II,VALUE,SOURCE,IEN,HELP,TYPE,ABLE,VISIBLE
  1.  S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1.  S DATA=$NA(^TMP("AGGVTCLM",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.  D HDR
  1.  S @DATA@(II)=HDR_$C(30)
  1.  I $G(AGGVCLMN)="SS" S VALUE=$P(^DPT(DFN,0),U,9)
  1.  I $G(AGGVCLMN)'="SS" S VALUE=$G(AGGVCLMN)
  1.  S SOURCE="AGGVCLMN",HELP="",TYPE="X",ABLE="Y" D UP
  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. UP ;
  1.  S II=II+1,@DATA@(II)=SOURCE_U_TYPE_U_VALUE_U_ABLE_U_$G(CLEAR)_U_HELP_U_$G(VISIBLE)_$C(30)
  1.  Q
  1.  ;
  1. GRP(DATA,DEF,GROUP) ; EP -- AGG INSUR GROUP TRIGGER
  1.  NEW UID,II,VALUE,SOURCE,IEN,HELP,TYPE,ABLE,AGWIEN,FILE,VISIBLE
  1.  S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1.  S DATA=$NA(^TMP("AGGTRGRP",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.  D HDR
  1.  S @DATA@(II)=HDR_$C(30)
  1.  S AGWIEN=$$FIND1^DIC(9009068.3,"","BX",DEF,"","","ERROR")
  1.  S FILE=$P(^AGG(9009068.3,AGWIEN,0),U,2)
  1.  S SOURCE=$S(FILE=9000004:"AGGMDGRN",1:"AGGPIGRN")
  1.  S ABLE="Y",HELP="",VALUE="",TYPE="X"
  1.  I $G(GROUP)'="" S VALUE=$P($G(^AUTNEGRP(GROUP,0)),U,2)
  1.  D UP
  1.  ;
  1.  S II=II+1,@DATA@(II)=$C(31)
  1.  Q
  1.  ;
  1. MIG(DATA,MGRNT) ;EP -- AGG MIGRNT TRIGGER
  1.  NEW UID,II,VALUE,SOURCE,IEN,HELP,TYPE,ABLE,AGWIEN,FILE,VISIBLE
  1.  S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1.  S DATA=$NA(^TMP("AGGTRMIG",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.  D HDR
  1.  S @DATA@(II)=HDR_$C(30)
  1.  S AGWIEN=$$FIND1^DIC(9009068.3,"","BX","Other Patient","","","ERROR")
  1.  S SOURCE="AGGMGTYP",IEN=$O(^AGG(9009068.3,AGWIEN,10,"AC",SOURCE,""))
  1.  S TYPE=$P($G(^AGG(9009068.3,AGWIEN,10,IEN,1)),"^",1)
  1.  S ABLE=$S($G(MGRNT)="Y":"Y",1:"N"),HELP="",VALUE=""
  1.  I TYPE="C"!(TYPE="K") D
  1.  . S CIEN=0
  1.  . F  S CIEN=$O(^AGG(9009068.3,AGWIEN,10,IEN,5,CIEN)) Q:'CIEN  D
  1.  .. NEW CDATA
  1.  .. S CDATA=^AGG(9009068.3,AGWIEN,10,IEN,5,CIEN,0)
  1.  .. S VALUE=VALUE_$P(CDATA,U,2)_$C(29)_$P(CDATA,U,1)_$C(28)
  1.  . S VALUE=$$TKO^AGGUL1(VALUE,$C(28))
  1.  D UP
  1.  ;
  1.  S II=II+1,@DATA@(II)=$C(31)
  1.  Q
  1.  ;
  1. HOM(DATA,HMLS) ;EP -- AGG HOMELESS TRIGGER
  1.  NEW UID,II,VALUE,SOURCE,IEN,HELP,TYPE,ABLE,AGWIEN,FILE,VISIBLE
  1.  S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1.  S DATA=$NA(^TMP("AGGTRHMLS",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.  D HDR
  1.  S @DATA@(II)=HDR_$C(30)
  1.  S AGWIEN=$$FIND1^DIC(9009068.3,"","BX","Other Patient","","","ERROR")
  1.  S SOURCE="AGGHMTYP",IEN=$O(^AGG(9009068.3,AGWIEN,10,"AC",SOURCE,""))
  1.  S TYPE=$P($G(^AGG(9009068.3,AGWIEN,10,IEN,1)),"^",1)
  1.  S ABLE=$S($G(HMLS)="Y":"Y",1:"N"),HELP="",VALUE=""
  1.  I TYPE="C"!(TYPE="K") D
  1.  . S CIEN=0
  1.  . F  S CIEN=$O(^AGG(9009068.3,AGWIEN,10,IEN,5,CIEN)) Q:'CIEN  D
  1.  .. NEW CDATA
  1.  .. S CDATA=^AGG(9009068.3,AGWIEN,10,IEN,5,CIEN,0)
  1.  .. S VALUE=VALUE_$P(CDATA,U,2)_$C(29)_$P(CDATA,U,1)_$C(28)
  1.  . S VALUE=$$TKO^AGGUL1(VALUE,$C(28))
  1.  D UP
  1.  ;
  1.  S II=II+1,@DATA@(II)=$C(31)
  1.  Q
  1.  ;
  1. COMM(DATA,DFN,COMM) ;EP - AGG COMMUNITY TRIGGER
  1.  NEW UID,II,VALUE,SOURCE,IEN,HELP,TYPE,ABLE,AGWIEN,FILE,DTMV,PCOMM,VISIBLE
  1.  S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1.  S DATA=$NA(^TMP("AGGTRCOMM",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.  D HDR
  1.  S @DATA@(II)=HDR_$C(30)
  1.  S DTMV=$O(^AUPNPAT(DFN,51,"A"),-1)
  1.  I +DTMV'=0 S PCOMM=$P(^AUPNPAT(DFN,51,DTMV,0),U,3)
  1.  S SOURCE="AGGPTCDT",TYPE="D",ABLE="Y" D
  1.  . I $G(PCOMM)="" S CLEAR="",HELP="",VALUE="" D UP Q
  1.  . I $G(PCOMM)=COMM S CLEAR="",HELP="",VALUE="" D UP Q
  1.  . S CLEAR="AGGPTCDT",HELP="",VALUE="" D UP
  1.  S SOURCE="AGGCMCNY",TYPE="X",HELP="",ABLE="Y",VALUE="",CLEAR=""
  1.  I $G(COMM)'="" S VALUE=$$GET1^DIQ(9999999.05,COMM_",",.02,"E") D UP
  1.  ;
  1.  S II=II+1,@DATA@(II)=$C(31)
  1.  Q
  1.  ;
  1. DTM(DATA,DFN,DATE) ;EP - AGG DATE MOVED TRIGGER
  1.  NEW UID,II,VALUE,SOURCE,IEN,HELP,TYPE,ABLE,AGWIEN,FILE,VISIBLE
  1.  S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1.  S DATA=$NA(^TMP("AGGTRDTM",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.  D HDR
  1.  S @DATA@(II)=HDR_$C(30)
  1.  I DATE?.A S DATE=$$UP^XLFSTR(DATE)
  1.  I $E(DATE,1,1)="B" S DATE=$P(^DPT(DFN,0),U,3)
  1.  I $E(DATE,1,1)="T" S DATE=DT
  1.  S DATE=$$DATE^AGGUL1(DATE),DATE=$$FMTE^AGGUL1(DATE)
  1.  S SOURCE="AGGPTCDT",TYPE="D",ABLE="Y",CLEAR="",HELP="Enter 'B' for at birth, TODAY or any date format",VALUE=DATE
  1.  D UP
  1.  ;
  1.  S II=II+1,@DATA@(II)=$C(31)
  1.  Q
  1.  ;
  1. MEM(DATA,DFN,AGGPIIEN,PINUM) ;EP - AGG POLICY MEMBER NUMBER TRIG
  1.  NEW UID,II,VALUE,SOURCE,IEN,HELP,TYPE,ABLE,MBNUM,VISIBLE
  1.  S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1.  S DATA=$NA(^TMP("AGGPINMB",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.  D HDR
  1.  S @DATA@(II)=HDR_$C(30)
  1.  ;
  1.  I $G(AGGPIIEN)'="" D
  1.  . NEW IENS,DA
  1.  . S DA(1)=DFN,DA=AGGPIIEN,IENS=$$IENS^DILF(.DA)
  1.  . S MBNUM=$$GET1^DIQ(9000006.11,IENS,21,"E")
  1.  I $G(PINUM)'="",$G(MBNUM)="" S SOURCE="AGGPIMBN",TYPE="X",ABLE="Y",CLEAR="",HELP="",VALUE=PINUM D UP
  1.  ;
  1.  S II=II+1,@DATA@(II)=$C(31)
  1.  Q
  1.  ;
  1. CTY(DATA,DFN,AGGPTCTY) ;EP - AGG CITY COMMUNITY TRIGGER
  1.  NEW UID,II,VALUE,SOURCE,IEN,HELP,TYPE,ABLE,AGWIEN,FILE,VISIBLE
  1.  S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1.  S DATA=$NA(^TMP("AGGTRCOMM",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.  D HDR
  1.  S @DATA@(II)=HDR_$C(30)
  1.  S CTY=$$GET1^DIQ(2,DFN_",",.114,"E")
  1.  I CTY'="",CTY'=$G(AGGPTCTY) D
  1.  . S SOURCE="AGGPTCOM",TYPE="D",ABLE="Y",CLEAR="AGGPTCOM",HELP="",VALUE="" D UP
  1.  . ;S SOURCE="AGGPTCDT",TYPE="D",ABLE="Y",CLEAR="AGGPTCDT",HELP="",VALUE="" D UP
  1.  . S SOURCE="AGGCMCNY",TYPE="X",ABLE="Y",CLEAR="AGGCMCNY",HELP="",VALUE="" D UP
  1.  ;
  1.  S II=II+1,@DATA@(II)=$C(31)
  1.  Q