AGGRPAT ;VNGT/HS/ALA-Recent Patient save and retrieve ; 16 May 2010 1:07 PM
;;1.0;PATIENT REGISTRATION GUI;;Nov 15, 2010
;
;
GET(DATA,FAKE) ; EP - AGG RECENT PATIENT RETRIEVE
; Input
; FAKE - extra 'blank' parameter required by BMXNET async 'feature'
;
; Output:
; DATA = name of global (passed by reference) in which the data is stored
;
; or
; BMXSEC - if M error encountered
;
NEW UID,II,DIEN,SDT,INFO,SGLOB,CNT,QFL
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("AGGRPAT",UID))
K @DATA
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^AGGRPAT D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
; Create header record
; I00010RESULT^
S II=0,@DATA@(II)="I00010DIEN^T00030SDT^T01024INFO"_$C(30)
;
S SGLOB=$NA(^XTMP("AGGRPAT",DUZ)),SDT="A",CNT=10,QFL=0
;F S JJ=$O(@SGLOB@(JJ)) Q:'JJ S PLIST=PLIST_$S(PLIST]"":$C(29),1:"")_JJ
;
F S SDT=$O(@SGLOB@(SDT),-1) Q:'SDT D Q:QFL
. S DIEN=0
. F S DIEN=$O(@SGLOB@(SDT,DIEN)) Q:'DIEN D Q:QFL
.. S LOC=DUZ(2)
.. S INFO=$G(@SGLOB@(SDT,DIEN,LOC)) I INFO="" Q
.. S II=II+1,@DATA@(II)=DIEN_"^"_$$FMTE^XLFDT(SDT)_"^"_INFO_$C(30)
.. I II+1>CNT S QFL=1
S II=II+1,@DATA@(II)=$C(31)
Q
;
SAVE(DATA,NUM,DIEN,INFO) ; EP - AGG SAVE RECENT PATIENT LIST
; Input
; NUM - Max number of enties to keep
; DIEN - (DFN) Patient's IEN
; INFO - extra data to be stored
;
; Output:
; DATA = name of global (passed by reference) in which the data is stored
; RESULT = 1 (unlock will always succeed)
; RESULT = -1 if invalid patient IEN (shouldn't happen)
; or
; BMXSEC - if M error encountered
;
NEW UID,II
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("AGGRPAT",UID))
K @DATA
;
;Set to a minimum number or keep at a low of five
I +$G(NUM)<1 S NUM=1
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^AGGRPAT D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
;
; Create header record
S II=0,@DATA@(II)="I00010RESULT"_$C(30)
NEW RESULT,I,SDT,IEN,CNT
S RESULT=0
S SGLOB=$NA(^XTMP("AGGRPAT",DUZ))
S @SGLOB@(0)=$$FMADD^XLFDT(DT,1825)_U_DT_U_"Recent Patient List"
; Check to see if patient is already in list, if so remove old entry
S SDT=0
F S SDT=$O(@SGLOB@(SDT)) Q:'SDT D
. S IEN=0 F S IEN=$O(@SGLOB@(SDT,IEN)) Q:'IEN I IEN=DIEN K @SGLOB@(SDT,IEN,DUZ(2))
; Save new entry
S SDT=$$NOW^XLFDT()
S @SGLOB@(SDT,DIEN,DUZ(2))=INFO
; Count entries
S SDT=0,CNT=0
F S SDT=$O(@SGLOB@(SDT)) Q:'SDT D
. S IEN=0 F S IEN=$O(@SGLOB@(SDT,IEN)) Q:'IEN D
.. I $O(@SGLOB@(SDT,IEN,""))="" K @SGLOB@(SDT,IEN) Q ;Clean out entries without locations
.. I $G(@SGLOB@(SDT,IEN,DUZ(2)))="" Q
.. S CNT=CNT+1
; If list contains too many enties remove the extra entries
F I=1:1:(CNT-NUM) D
. S SDT=$O(@SGLOB@(0))
. S IEN=$O(@SGLOB@(SDT,0))
. I $G(@SGLOB@(SDT,IEN,DUZ(2)))="" Q
. K @SGLOB@(SDT,IEN)
;
S RESULT=1
S II=II+1,@DATA@(II)=RESULT_$C(30)
S II=II+1,@DATA@(II)=$C(31)
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
AGGRPAT ;VNGT/HS/ALA-Recent Patient save and retrieve ; 16 May 2010 1:07 PM
+1 ;;1.0;PATIENT REGISTRATION GUI;;Nov 15, 2010
+2 ;
+3 ;
GET(DATA,FAKE) ; EP - AGG RECENT PATIENT RETRIEVE
+1 ; Input
+2 ; FAKE - extra 'blank' parameter required by BMXNET async 'feature'
+3 ;
+4 ; Output:
+5 ; DATA = name of global (passed by reference) in which the data is stored
+6 ;
+7 ; or
+8 ; BMXSEC - if M error encountered
+9 ;
+10 NEW UID,II,DIEN,SDT,INFO,SGLOB,CNT,QFL
+11 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+12 SET DATA=$NAME(^TMP("AGGRPAT",UID))
+13 KILL @DATA
+14 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^AGGRPAT D UNWIND^%ZTER"
+15 ; Create header record
+16 ; I00010RESULT^
+17 SET II=0
SET @DATA@(II)="I00010DIEN^T00030SDT^T01024INFO"_$CHAR(30)
+18 ;
+19 SET SGLOB=$NAME(^XTMP("AGGRPAT",DUZ))
SET SDT="A"
SET CNT=10
SET QFL=0
+20 ;F S JJ=$O(@SGLOB@(JJ)) Q:'JJ S PLIST=PLIST_$S(PLIST]"":$C(29),1:"")_JJ
+21 ;
+22 FOR
SET SDT=$ORDER(@SGLOB@(SDT),-1)
IF 'SDT
QUIT
Begin DoDot:1
+23 SET DIEN=0
+24 FOR
SET DIEN=$ORDER(@SGLOB@(SDT,DIEN))
IF 'DIEN
QUIT
Begin DoDot:2
+25 SET LOC=DUZ(2)
+26 SET INFO=$GET(@SGLOB@(SDT,DIEN,LOC))
IF INFO=""
QUIT
+27 SET II=II+1
SET @DATA@(II)=DIEN_"^"_$$FMTE^XLFDT(SDT)_"^"_INFO_$CHAR(30)
+28 IF II+1>CNT
SET QFL=1
End DoDot:2
IF QFL
QUIT
End DoDot:1
IF QFL
QUIT
+29 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+30 QUIT
+31 ;
SAVE(DATA,NUM,DIEN,INFO) ; EP - AGG SAVE RECENT PATIENT LIST
+1 ; Input
+2 ; NUM - Max number of enties to keep
+3 ; DIEN - (DFN) Patient's IEN
+4 ; INFO - extra data to be stored
+5 ;
+6 ; Output:
+7 ; DATA = name of global (passed by reference) in which the data is stored
+8 ; RESULT = 1 (unlock will always succeed)
+9 ; RESULT = -1 if invalid patient IEN (shouldn't happen)
+10 ; or
+11 ; BMXSEC - if M error encountered
+12 ;
+13 NEW UID,II
+14 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+15 SET DATA=$NAME(^TMP("AGGRPAT",UID))
+16 KILL @DATA
+17 ;
+18 ;Set to a minimum number or keep at a low of five
+19 IF +$GET(NUM)<1
SET NUM=1
+20 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^AGGRPAT D UNWIND^%ZTER"
+21 ;
+22 ; Create header record
+23 SET II=0
SET @DATA@(II)="I00010RESULT"_$CHAR(30)
+24 NEW RESULT,I,SDT,IEN,CNT
+25 SET RESULT=0
+26 SET SGLOB=$NAME(^XTMP("AGGRPAT",DUZ))
+27 SET @SGLOB@(0)=$$FMADD^XLFDT(DT,1825)_U_DT_U_"Recent Patient List"
+28 ; Check to see if patient is already in list, if so remove old entry
+29 SET SDT=0
+30 FOR
SET SDT=$ORDER(@SGLOB@(SDT))
IF 'SDT
QUIT
Begin DoDot:1
+31 SET IEN=0
FOR
SET IEN=$ORDER(@SGLOB@(SDT,IEN))
IF 'IEN
QUIT
IF IEN=DIEN
KILL @SGLOB@(SDT,IEN,DUZ(2))
End DoDot:1
+32 ; Save new entry
+33 SET SDT=$$NOW^XLFDT()
+34 SET @SGLOB@(SDT,DIEN,DUZ(2))=INFO
+35 ; Count entries
+36 SET SDT=0
SET CNT=0
+37 FOR
SET SDT=$ORDER(@SGLOB@(SDT))
IF 'SDT
QUIT
Begin DoDot:1
+38 SET IEN=0
FOR
SET IEN=$ORDER(@SGLOB@(SDT,IEN))
IF 'IEN
QUIT
Begin DoDot:2
+39 ;Clean out entries without locations
IF $ORDER(@SGLOB@(SDT,IEN,""))=""
KILL @SGLOB@(SDT,IEN)
QUIT
+40 IF $GET(@SGLOB@(SDT,IEN,DUZ(2)))=""
QUIT
+41 SET CNT=CNT+1
End DoDot:2
End DoDot:1
+42 ; If list contains too many enties remove the extra entries
+43 FOR I=1:1:(CNT-NUM)
Begin DoDot:1
+44 SET SDT=$ORDER(@SGLOB@(0))
+45 SET IEN=$ORDER(@SGLOB@(SDT,0))
+46 IF $GET(@SGLOB@(SDT,IEN,DUZ(2)))=""
QUIT
+47 KILL @SGLOB@(SDT,IEN)
End DoDot:1
+48 ;
+49 SET RESULT=1
+50 SET II=II+1
SET @DATA@(II)=RESULT_$CHAR(30)
+51 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+52 QUIT
+53 ;
+54 ;
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
