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