AGGPALTR ;VNGT/HS/BEE-Alternate Resources Field Handling ; 02 May 2010 9:08 AM
;;1.0;PATIENT REGISTRATION GUI;;Nov 15, 2010
;
Q
;
UROI(AGPATDFN,AGROI) ;PEP - Update RELEASE OF INFORMATION (#3601)
;
;Input:
; AGPATDFN - Patient IEN
; AGROI - New Release of Information Date
;
;Output:
;Returns -1^Error Message - on Failure
; "" - on Success
;
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^AGGPALTR D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
;
Q:AGPATDFN="" "-1^Missing Patient IEN"
Q:AGROI="" ""
;
N AGG,DA,DIC,DLAYGO,ERROR,X,Y
;
;Define new entry and save
S DIC="^AUPNPAT("_AGPATDFN_",36,",DA(1)=AGPATDFN
S DIC(0)="L"
S X=$$DATE^AGGUL1(AGROI)
S DLAYGO="9000001.03601",DIC("P")=DLAYGO
I '$D(^AUPNPAT(AGPATDFN,36,0)) S ^AUPNPAT(AGPATDFN,36,0)="^9000001.03601D^^"
D ^DIC
;
;Successful Save
Q ""
;
UAOB(AGPATDFN,AGAOB) ;PEP - Update ASSIGN BENEFITS OBTAINED DATE (#7101)
;
;Input:
; AGPATDFN - Patient IEN
; AGAOB - New ASSIGN BENEFITS OBTAINED DATE Date
;
;Output:
;Returns -1^Error Message - on Failure
; "" - on Success
;
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^AGGPALTR D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
;
Q:AGPATDFN="" "-1^Missing Patient IEN"
Q:AGAOB="" ""
;
N AGG,DA,DIC,DLAYGO,ERROR,X,Y
;
;Define new entry and save
S DIC="^AUPNPAT("_AGPATDFN_",71,",DA(1)=AGPATDFN
S DIC(0)="L"
S X=$$DATE^AGGUL1(AGAOB)
S DLAYGO="9000001.71",DIC("P")=DLAYGO
I '$D(^AUPNPAT(AGPATDFN,71,0)) S ^AUPNPAT(AGPATDFN,71,0)="^9000001.71D^^"
D ^DIC
;
;Successful Save
Q ""
;
AOB(DATA,AGGPTAOB,AGGPTROI) ; EP -- AGG ALT RES AOB TRG
; Input
; AGGPTAOB - The current AOB Date
; AGGPTROI - The current ROI Date
;
NEW UID,II,VALUE,SOURCE,IEN,HELP,TYPE,ABLE,HDR
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("AGGPALTR",UID))
K @DATA
S II=0
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^AGGPPALTR D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
D HDR
S @DATA@(II)=HDR_$C(30)
;
;Populate ROI if blank, Link parameter is yes, and AOB is populated
I $G(AGGPTAOB)]"",$G(AGGPTROI)="" D
. D ^AGVAR
. ;
. I AGOPT(25)="Y" D
.. N AOB,ROI,AGAOB,DA,ERROR,DIC,X,Y
.. ;
.. ;Plug in AOB
.. S SOURCE="AGGPTROI",VALUE=AGGPTAOB,HELP="",ABLE="Y",REQ="",CLEAR="",CLFLAG="",TYPE="D",VISIBLE="" D UP
;
S II=II+1,@DATA@(II)=$C(31)
Q
;
UP ;
S II=II+1,@DATA@(II)=SOURCE_U_TYPE_U_VALUE_U_ABLE_U_$G(CLEAR)_U_HELP_U_REQ_U_$G(VISIBLE)_$C(30)
Q
;
HDR ;
S HDR="T00008SOURCE^T00001CODE_TYPE^T01024PARMS^T00001ABLE_FLAG^T00100CLEAR_FIELDS^T00200HELP_TEXT^T00001REQ_OPT^T00001VISIBLE"
Q
;
ERR ;
D ^%ZTER
NEW Y,ERRDTM
S Y=$$NOW^XLFDT() X ^DD("DD") S ERRDTM=Y
S BMXSEC="Recording that an error occurred at "_ERRDTM
I $D(II),$D(DATA) S II=II+1,@DATA@(II)=$C(31)
Q
AGGPALTR ;VNGT/HS/BEE-Alternate Resources Field Handling ; 02 May 2010 9:08 AM
+1 ;;1.0;PATIENT REGISTRATION GUI;;Nov 15, 2010
+2 ;
+3 QUIT
+4 ;
UROI(AGPATDFN,AGROI) ;PEP - Update RELEASE OF INFORMATION (#3601)
+1 ;
+2 ;Input:
+3 ; AGPATDFN - Patient IEN
+4 ; AGROI - New Release of Information Date
+5 ;
+6 ;Output:
+7 ;Returns -1^Error Message - on Failure
+8 ; "" - on Success
+9 ;
+10 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^AGGPALTR D UNWIND^%ZTER"
+11 ;
+12 IF AGPATDFN=""
QUIT "-1^Missing Patient IEN"
+13 IF AGROI=""
QUIT ""
+14 ;
+15 NEW AGG,DA,DIC,DLAYGO,ERROR,X,Y
+16 ;
+17 ;Define new entry and save
+18 SET DIC="^AUPNPAT("_AGPATDFN_",36,"
SET DA(1)=AGPATDFN
+19 SET DIC(0)="L"
+20 SET X=$$DATE^AGGUL1(AGROI)
+21 SET DLAYGO="9000001.03601"
SET DIC("P")=DLAYGO
+22 IF '$DATA(^AUPNPAT(AGPATDFN,36,0))
SET ^AUPNPAT(AGPATDFN,36,0)="^9000001.03601D^^"
+23 DO ^DIC
+24 ;
+25 ;Successful Save
+26 QUIT ""
+27 ;
UAOB(AGPATDFN,AGAOB) ;PEP - Update ASSIGN BENEFITS OBTAINED DATE (#7101)
+1 ;
+2 ;Input:
+3 ; AGPATDFN - Patient IEN
+4 ; AGAOB - New ASSIGN BENEFITS OBTAINED DATE Date
+5 ;
+6 ;Output:
+7 ;Returns -1^Error Message - on Failure
+8 ; "" - on Success
+9 ;
+10 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^AGGPALTR D UNWIND^%ZTER"
+11 ;
+12 IF AGPATDFN=""
QUIT "-1^Missing Patient IEN"
+13 IF AGAOB=""
QUIT ""
+14 ;
+15 NEW AGG,DA,DIC,DLAYGO,ERROR,X,Y
+16 ;
+17 ;Define new entry and save
+18 SET DIC="^AUPNPAT("_AGPATDFN_",71,"
SET DA(1)=AGPATDFN
+19 SET DIC(0)="L"
+20 SET X=$$DATE^AGGUL1(AGAOB)
+21 SET DLAYGO="9000001.71"
SET DIC("P")=DLAYGO
+22 IF '$DATA(^AUPNPAT(AGPATDFN,71,0))
SET ^AUPNPAT(AGPATDFN,71,0)="^9000001.71D^^"
+23 DO ^DIC
+24 ;
+25 ;Successful Save
+26 QUIT ""
+27 ;
AOB(DATA,AGGPTAOB,AGGPTROI) ; EP -- AGG ALT RES AOB TRG
+1 ; Input
+2 ; AGGPTAOB - The current AOB Date
+3 ; AGGPTROI - The current ROI Date
+4 ;
+5 NEW UID,II,VALUE,SOURCE,IEN,HELP,TYPE,ABLE,HDR
+6 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+7 SET DATA=$NAME(^TMP("AGGPALTR",UID))
+8 KILL @DATA
+9 SET II=0
+10 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^AGGPPALTR D UNWIND^%ZTER"
+11 DO HDR
+12 SET @DATA@(II)=HDR_$CHAR(30)
+13 ;
+14 ;Populate ROI if blank, Link parameter is yes, and AOB is populated
+15 IF $GET(AGGPTAOB)]""
IF $GET(AGGPTROI)=""
Begin DoDot:1
+16 DO ^AGVAR
+17 ;
+18 IF AGOPT(25)="Y"
Begin DoDot:2
+19 NEW AOB,ROI,AGAOB,DA,ERROR,DIC,X,Y
+20 ;
+21 ;Plug in AOB
+22 SET SOURCE="AGGPTROI"
SET VALUE=AGGPTAOB
SET HELP=""
SET ABLE="Y"
SET REQ=""
SET CLEAR=""
SET CLFLAG=""
SET TYPE="D"
SET VISIBLE=""
DO UP
End DoDot:2
End DoDot:1
+23 ;
+24 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+25 QUIT
+26 ;
UP ;
+1 SET II=II+1
SET @DATA@(II)=SOURCE_U_TYPE_U_VALUE_U_ABLE_U_$GET(CLEAR)_U_HELP_U_REQ_U_$GET(VISIBLE)_$CHAR(30)
+2 QUIT
+3 ;
HDR ;
+1 SET HDR="T00008SOURCE^T00001CODE_TYPE^T01024PARMS^T00001ABLE_FLAG^T00100CLEAR_FIELDS^T00200HELP_TEXT^T00001REQ_OPT^T00001VISIBLE"
+2 QUIT
+3 ;
ERR ;
+1 DO ^%ZTER
+2 NEW Y,ERRDTM
+3 SET Y=$$NOW^XLFDT()
XECUTE ^DD("DD")
SET ERRDTM=Y
+4 SET BMXSEC="Recording that an error occurred at "_ERRDTM
+5 IF $DATA(II)
IF $DATA(DATA)
SET II=II+1
SET @DATA@(II)=$CHAR(31)
+6 QUIT
