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

AGGPALTR.m

Go to the documentation of this file. 
  1. AGGPALTR ;VNGT/HS/BEE-Alternate Resources Field Handling ; 02 May 2010  9:08 AM
  1.  ;;1.0;PATIENT REGISTRATION GUI;;Nov 15, 2010
  1.  ;
  1.  Q
  1.  ;
  1. UROI(AGPATDFN,AGROI) ;PEP - Update RELEASE OF INFORMATION (#3601)
  1.  ;
  1.  ;Input:
  1.  ; AGPATDFN - Patient IEN
  1.  ; AGROI - New Release of Information Date
  1.  ;
  1.  ;Output:
  1.  ;Returns -1^Error Message - on Failure
  1.  ;        "" - on Success
  1.  ;
  1.  NEW $ESTACK,$ETRAP S $ETRAP="D ERR^AGGPALTR D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
  1.  ;
  1.  Q:AGPATDFN="" "-1^Missing Patient IEN"
  1.  Q:AGROI="" ""
  1.  ;
  1.  N AGG,DA,DIC,DLAYGO,ERROR,X,Y
  1.  ;
  1.  ;Define new entry and save
  1.  S DIC="^AUPNPAT("_AGPATDFN_",36,",DA(1)=AGPATDFN
  1.  S DIC(0)="L"
  1.  S X=$$DATE^AGGUL1(AGROI)
  1.  S DLAYGO="9000001.03601",DIC("P")=DLAYGO
  1.  I '$D(^AUPNPAT(AGPATDFN,36,0)) S ^AUPNPAT(AGPATDFN,36,0)="^9000001.03601D^^"
  1.  D ^DIC
  1.  ;
  1.  ;Successful Save
  1.  Q ""
  1.  ;
  1. UAOB(AGPATDFN,AGAOB) ;PEP - Update ASSIGN BENEFITS OBTAINED DATE (#7101)
  1.  ;
  1.  ;Input:
  1.  ; AGPATDFN - Patient IEN
  1.  ; AGAOB - New ASSIGN BENEFITS OBTAINED DATE Date
  1.  ;
  1.  ;Output:
  1.  ;Returns -1^Error Message - on Failure
  1.  ;        "" - on Success
  1.  ;
  1.  NEW $ESTACK,$ETRAP S $ETRAP="D ERR^AGGPALTR D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
  1.  ;
  1.  Q:AGPATDFN="" "-1^Missing Patient IEN"
  1.  Q:AGAOB="" ""
  1.  ;
  1.  N AGG,DA,DIC,DLAYGO,ERROR,X,Y
  1.  ;
  1.  ;Define new entry and save
  1.  S DIC="^AUPNPAT("_AGPATDFN_",71,",DA(1)=AGPATDFN
  1.  S DIC(0)="L"
  1.  S X=$$DATE^AGGUL1(AGAOB)
  1.  S DLAYGO="9000001.71",DIC("P")=DLAYGO
  1.  I '$D(^AUPNPAT(AGPATDFN,71,0)) S ^AUPNPAT(AGPATDFN,71,0)="^9000001.71D^^"
  1.  D ^DIC
  1.  ;
  1.  ;Successful Save
  1.  Q ""
  1.  ;
  1. AOB(DATA,AGGPTAOB,AGGPTROI) ; EP -- AGG ALT RES AOB TRG
  1.  ; Input
  1.  ;   AGGPTAOB - The current AOB Date
  1.  ;   AGGPTROI - The current ROI Date
  1.  ;
  1.  NEW UID,II,VALUE,SOURCE,IEN,HELP,TYPE,ABLE,HDR
  1.  S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1.  S DATA=$NA(^TMP("AGGPALTR",UID))
  1.  K @DATA
  1.  S II=0
  1.  NEW $ESTACK,$ETRAP S $ETRAP="D ERR^AGGPPALTR D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
  1.  D HDR
  1.  S @DATA@(II)=HDR_$C(30)
  1.  ;
  1.  ;Populate ROI if blank, Link parameter is yes, and AOB is populated
  1.  I $G(AGGPTAOB)]"",$G(AGGPTROI)="" D
  1.  . D ^AGVAR
  1.  . ;
  1.  . I AGOPT(25)="Y" D
  1.  .. N AOB,ROI,AGAOB,DA,ERROR,DIC,X,Y
  1.  .. ;
  1.  .. ;Plug in AOB
  1.  .. S SOURCE="AGGPTROI",VALUE=AGGPTAOB,HELP="",ABLE="Y",REQ="",CLEAR="",CLFLAG="",TYPE="D",VISIBLE="" D UP
  1.  ;
  1.  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_REQ_U_$G(VISIBLE)_$C(30)
  1.  Q
  1.  ;
  1. HDR ;
  1.  S HDR="T00008SOURCE^T00001CODE_TYPE^T01024PARMS^T00001ABLE_FLAG^T00100CLEAR_FIELDS^T00200HELP_TEXT^T00001REQ_OPT^T00001VISIBLE"
  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