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

AGGRPAT.m

Go to the documentation of this file. 
  1. AGGRPAT ;VNGT/HS/ALA-Recent Patient save and retrieve ; 16 May 2010  1:07 PM
  1.  ;;1.0;PATIENT REGISTRATION GUI;;Nov 15, 2010
  1.  ;
  1.  ;
  1. GET(DATA,FAKE) ; EP - AGG RECENT PATIENT RETRIEVE
  1.  ; Input
  1.  ;  FAKE - extra 'blank' parameter required by BMXNET async 'feature'
  1.  ;   
  1.  ; Output:
  1.  ;   DATA  = name of global (passed by reference) in which the data is stored
  1.  ;
  1.  ; or
  1.  ;   BMXSEC - if M error encountered
  1.  ;            
  1.  NEW UID,II,DIEN,SDT,INFO,SGLOB,CNT,QFL
  1.  S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1.  S DATA=$NA(^TMP("AGGRPAT",UID))
  1.  K @DATA
  1.  NEW $ESTACK,$ETRAP S $ETRAP="D ERR^AGGRPAT D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
  1.  ; Create header record
  1.  ; I00010RESULT^
  1.  S II=0,@DATA@(II)="I00010DIEN^T00030SDT^T01024INFO"_$C(30)
  1.  ;
  1.  S SGLOB=$NA(^XTMP("AGGRPAT",DUZ)),SDT="A",CNT=10,QFL=0
  1.  ;F  S JJ=$O(@SGLOB@(JJ)) Q:'JJ  S PLIST=PLIST_$S(PLIST]"":$C(29),1:"")_JJ
  1.  ;
  1.  F  S SDT=$O(@SGLOB@(SDT),-1) Q:'SDT  D  Q:QFL
  1.  . S DIEN=0
  1.  . F  S DIEN=$O(@SGLOB@(SDT,DIEN)) Q:'DIEN  D  Q:QFL
  1.  .. S LOC=DUZ(2)
  1.  .. S INFO=$G(@SGLOB@(SDT,DIEN,LOC)) I INFO="" Q
  1.  .. S II=II+1,@DATA@(II)=DIEN_"^"_$$FMTE^XLFDT(SDT)_"^"_INFO_$C(30)
  1.  .. I II+1>CNT S QFL=1
  1.  S II=II+1,@DATA@(II)=$C(31)
  1.  Q
  1.  ;
  1. SAVE(DATA,NUM,DIEN,INFO) ; EP - AGG SAVE RECENT PATIENT LIST
  1.  ; Input
  1.  ;   NUM   - Max number of enties to keep
  1.  ;   DIEN  - (DFN) Patient's IEN
  1.  ;   INFO  - extra data to be stored
  1.  ;   
  1.  ; Output:
  1.  ;   DATA  = name of global (passed by reference) in which the data is stored
  1.  ;   RESULT = 1 (unlock will always succeed)
  1.  ;   RESULT = -1 if invalid patient IEN (shouldn't happen)
  1.  ; or
  1.  ;   BMXSEC - if M error encountered
  1.  ;            
  1.  NEW UID,II
  1.  S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1.  S DATA=$NA(^TMP("AGGRPAT",UID))
  1.  K @DATA
  1.  ;
  1.  ;Set to a minimum number or keep at a low of five
  1.  I +$G(NUM)<1 S NUM=1
  1.  NEW $ESTACK,$ETRAP S $ETRAP="D ERR^AGGRPAT D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
  1.  ;
  1.  ; Create header record
  1.  S II=0,@DATA@(II)="I00010RESULT"_$C(30)
  1.  NEW RESULT,I,SDT,IEN,CNT
  1.  S RESULT=0
  1.  S SGLOB=$NA(^XTMP("AGGRPAT",DUZ))
  1.  S @SGLOB@(0)=$$FMADD^XLFDT(DT,1825)_U_DT_U_"Recent Patient List"
  1.  ; Check to see if patient is already in list, if so remove old entry
  1.  S SDT=0
  1.  F  S SDT=$O(@SGLOB@(SDT)) Q:'SDT  D
  1.  . S IEN=0 F  S IEN=$O(@SGLOB@(SDT,IEN)) Q:'IEN  I IEN=DIEN K @SGLOB@(SDT,IEN,DUZ(2))
  1.  ; Save new entry
  1.  S SDT=$$NOW^XLFDT()
  1.  S @SGLOB@(SDT,DIEN,DUZ(2))=INFO
  1.  ; Count entries
  1.  S SDT=0,CNT=0
  1.  F  S SDT=$O(@SGLOB@(SDT)) Q:'SDT  D
  1.  . S IEN=0 F  S IEN=$O(@SGLOB@(SDT,IEN)) Q:'IEN  D
  1.  .. I $O(@SGLOB@(SDT,IEN,""))="" K @SGLOB@(SDT,IEN) Q  ;Clean out entries without locations
  1.  .. I $G(@SGLOB@(SDT,IEN,DUZ(2)))="" Q
  1.  .. S CNT=CNT+1
  1.  ; If list contains too many enties remove the extra entries
  1.  F I=1:1:(CNT-NUM) D
  1.  . S SDT=$O(@SGLOB@(0))
  1.  . S IEN=$O(@SGLOB@(SDT,0))
  1.  . I $G(@SGLOB@(SDT,IEN,DUZ(2)))="" Q
  1.  . K @SGLOB@(SDT,IEN)
  1.  ;
  1.  S RESULT=1
  1.  S II=II+1,@DATA@(II)=RESULT_$C(30)
  1.  S II=II+1,@DATA@(II)=$C(31)
  1.  Q
  1.  ;
  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