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

AGGPTNEW.m

Go to the documentation of this file.
  1. AGGPTNEW ;VNGT/HS/ALA-New Patient Trigger ; 21 Jun 2010 8:33 PM
  1. ;;1.0;PATIENT REGISTRATION GUI;;Nov 15, 2010
  1. ;
  1. ;
  1. INIT(DATA,DFN) ; EP -- AGG NEW PATIENT TRIGGER
  1. NEW UID,II,VALUE,SOURCE,IEN,HELP,TYPE,ABLE,AGGPTCLB,AGGPTSSV,AGGNOSSN,SSN,REQ
  1. S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1. S DATA=$NA(^TMP("AGGPTNEW",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 SOURCE="AGGPTCLB",TYPE="T",ABLE="Y",REQ="Y"
  1. S DVAL=$$TBL^AGGWDEF(9999999.25,"INDIAN/ALASKA NATIVE")
  1. S AGGPTCLB=$$GET1^DIQ(9000001,DFN_",",1111,"I")
  1. I AGGPTCLB="" S VALUE=DVAL
  1. I AGGPTCLB'="" S VALUE=AGGPTCLB_$C(28)_$$GET1^DIQ(9000001,DFN_",",1111,"E")
  1. S REQ="Y",HELP="" D UP
  1. ;
  1. K AGOPT
  1. F AG=2,3,9 S AGOPT(AG-1)=$P(^AGFAC(DUZ(2),0),U,AG)
  1. ;
  1. S SOURCE="AGGPTTEN",ABLE=$S(AGOPT(2)="Y":"Y",1:"N"),TYPE="X",VALUE="",CLEAR="",REQ="" D D UP
  1. . I ABLE="N" S HELP="TRIBAL ENROLLMENT NUMBER is not turned on for "_$P(^DIC(4,DUZ(2),0),U,1) Q
  1. . S HELP=""
  1. S SOURCE="AGGPTTRQ",ABLE=$S(AGOPT(1)="Y":"Y",1:"N"),TYPE="X",VALUE="",CLEAR="",REQ="" D D UP
  1. . I ABLE="N" S HELP="TRIBAL BLOOD QUANTUM is not turned on for "_$P(^DIC(4,DUZ(2),0),U,1) Q
  1. . S HELP=""
  1. S AGGPTSSV=$$GET1^DIQ(9000001,DFN_",",.23,"E")
  1. S AGGNOSSN=$$GET1^DIQ(9000001,DFN_",",.24,"E")
  1. S SSN=$$GET1^DIQ(2,DFN_",",.09,"E")
  1. ;
  1. I SSN'="",AGGNOSSN="" D
  1. . S SOURCE="AGGNOSSN",ABLE="N",VALUE="",TYPE="X",HELP="",CLEAR="",NOSAVE="N" D UP
  1. . I AGGPTSSV="P"!(AGGPTSSV="") S SOURCE="AGGPTSSN",ABLE="Y",VALUE="",TYPE="X",HELP="",CLEAR="",NOSAVE="N" D UP
  1. . I AGGPTSSV'="P",AGGPTSSV'="" S SOURCE="AGGPTSSN",ABLE="N",VALUE="",TYPE="X",HELP="",CLEAR="",NOSAVE="Y" D UP
  1. I SSN="",AGGNOSSN'="" D
  1. . S SOURCE="AGGNOSSN",ABLE="Y",VALUE="",TYPE="X",HELP="",CLEAR="",NOSAVE="N" D UP
  1. . S SOURCE="AGGPTSSN",ABLE="N",VALUE="",TYPE="X",HELP="",CLEAR="",NOSAVE="Y" D UP
  1. ;
  1. S II=II+1,@DATA@(II)=$C(31)
  1. K AGOPT,AG
  1. Q
  1. ;
  1. HDR ;
  1. S HDR="T00008SOURCE^T00001CODE_TYPE^T01024PARMS^T00001ABLE_FLAG^T00001REQ_OPT^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(REQ)_U_$G(CLEAR)_U_HELP_$C(30)
  1. Q