- 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
- AGGPTNEW ;VNGT/HS/ALA-New Patient Trigger ; 21 Jun 2010 8:33 PM
- +1 ;;1.0;PATIENT REGISTRATION GUI;;Nov 15, 2010
- +2 ;
- +3 ;
- INIT(DATA,DFN) ; EP -- AGG NEW PATIENT TRIGGER
- +1 NEW UID,II,VALUE,SOURCE,IEN,HELP,TYPE,ABLE,AGGPTCLB,AGGPTSSV,AGGNOSSN,SSN,REQ
- +2 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
- +3 SET DATA=$NAME(^TMP("AGGPTNEW",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 DO HDR
- +8 SET @DATA@(II)=HDR_$CHAR(30)
- +9 SET SOURCE="AGGPTCLB"
- SET TYPE="T"
- SET ABLE="Y"
- SET REQ="Y"
- +10 SET DVAL=$$TBL^AGGWDEF(9999999.25,"INDIAN/ALASKA NATIVE")
- +11 SET AGGPTCLB=$$GET1^DIQ(9000001,DFN_",",1111,"I")
- +12 IF AGGPTCLB=""
- SET VALUE=DVAL
- +13 IF AGGPTCLB'=""
- SET VALUE=AGGPTCLB_$CHAR(28)_$$GET1^DIQ(9000001,DFN_",",1111,"E")
- +14 SET REQ="Y"
- SET HELP=""
- DO UP
- +15 ;
- +16 KILL AGOPT
- +17 FOR AG=2,3,9
- SET AGOPT(AG-1)=$PIECE(^AGFAC(DUZ(2),0),U,AG)
- +18 ;
- +19 SET SOURCE="AGGPTTEN"
- SET ABLE=$SELECT(AGOPT(2)="Y":"Y",1:"N")
- SET TYPE="X"
- SET VALUE=""
- SET CLEAR=""
- SET REQ=""
- Begin DoDot:1
- +20 IF ABLE="N"
- SET HELP="TRIBAL ENROLLMENT NUMBER is not turned on for "_$PIECE(^DIC(4,DUZ(2),0),U,1)
- QUIT
- +21 SET HELP=""
- End DoDot:1
- DO UP
- +22 SET SOURCE="AGGPTTRQ"
- SET ABLE=$SELECT(AGOPT(1)="Y":"Y",1:"N")
- SET TYPE="X"
- SET VALUE=""
- SET CLEAR=""
- SET REQ=""
- Begin DoDot:1
- +23 IF ABLE="N"
- SET HELP="TRIBAL BLOOD QUANTUM is not turned on for "_$PIECE(^DIC(4,DUZ(2),0),U,1)
- QUIT
- +24 SET HELP=""
- End DoDot:1
- DO UP
- +25 SET AGGPTSSV=$$GET1^DIQ(9000001,DFN_",",.23,"E")
- +26 SET AGGNOSSN=$$GET1^DIQ(9000001,DFN_",",.24,"E")
- +27 SET SSN=$$GET1^DIQ(2,DFN_",",.09,"E")
- +28 ;
- +29 IF SSN'=""
- IF AGGNOSSN=""
- Begin DoDot:1
- +30 SET SOURCE="AGGNOSSN"
- SET ABLE="N"
- SET VALUE=""
- SET TYPE="X"
- SET HELP=""
- SET CLEAR=""
- SET NOSAVE="N"
- DO UP
- +31 IF AGGPTSSV="P"!(AGGPTSSV="")
- SET SOURCE="AGGPTSSN"
- SET ABLE="Y"
- SET VALUE=""
- SET TYPE="X"
- SET HELP=""
- SET CLEAR=""
- SET NOSAVE="N"
- DO UP
- +32 IF AGGPTSSV'="P"
- IF AGGPTSSV'=""
- SET SOURCE="AGGPTSSN"
- SET ABLE="N"
- SET VALUE=""
- SET TYPE="X"
- SET HELP=""
- SET CLEAR=""
- SET NOSAVE="Y"
- DO UP
- End DoDot:1
- +33 IF SSN=""
- IF AGGNOSSN'=""
- Begin DoDot:1
- +34 SET SOURCE="AGGNOSSN"
- SET ABLE="Y"
- SET VALUE=""
- SET TYPE="X"
- SET HELP=""
- SET CLEAR=""
- SET NOSAVE="N"
- DO UP
- +35 SET SOURCE="AGGPTSSN"
- SET ABLE="N"
- SET VALUE=""
- SET TYPE="X"
- SET HELP=""
- SET CLEAR=""
- SET NOSAVE="Y"
- DO UP
- End DoDot:1
- +36 ;
- +37 SET II=II+1
- SET @DATA@(II)=$CHAR(31)
- +38 KILL AGOPT,AG
- +39 QUIT
- +40 ;
- HDR ;
- +1 SET HDR="T00008SOURCE^T00001CODE_TYPE^T01024PARMS^T00001ABLE_FLAG^T00001REQ_OPT^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(REQ)_U_$GET(CLEAR)_U_HELP_$CHAR(30)
- +2 QUIT