AGGPTHRN.m

AGGPTHRN ;VNGT/HS/ALA-Patient HRN ; 24 May 2010  9:29 AM

 ;;1.0;PATIENT REGISTRATION GUI;;Nov 15, 2010

 ;

 ;

GTMP(DATA,DFN) ; EP -- AGG GET TEMP PAT HRN

 ;

 NEW UID,II,THRN

 S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)

 S DATA=$NA(^TMP("AGGPTHRN",UID))

 K @DATA

 S II=0

 NEW $ESTACK,$ETRAP S $ETRAP="D ERR^AGGWDISP D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2

 S @DATA@(II)="T00010AGGPTHRN"_$C(30)

 S THRN=$$THRN()

 S ^AUPNPAT("D",THRN,DFN,DUZ(2))=""

 S II=II+1,@DATA@(II)=THRN_$C(30)

 S II=II+1,@DATA@(II)=$C(31)

 Q

 ;

THRN() ;EP - Get a temporary HRN number

 NEW AGCH,AGTCH

 S AGCH=999999

 S AGTCH=0,QFL=0

 F I=0:0 S AGCH=$O(^AUPNPAT("D",AGCH)) Q:AGCH=""  D  Q:QFL

 . I $D(^AUPNPAT("D",AGCH,DFN)) S AGTCH=AGCH,QFL=1

 . S AGTCH=AGCH

 ;

 I 'QFL D

 . S:AGTCH=0 AGTCH="T00000"

 . S AGTCH=$E(AGTCH,2,6)

 . S AGTCH=AGTCH+1

 . S AGTCH="T"_$E(100000+AGTCH,2,6)

 Q AGTCH

AGGPTHRN  ;VNGT/HS/ALA-Patient HRN ; 24 May 2010  9:29 AM

 +1       ;;1.0;PATIENT REGISTRATION GUI;;Nov 15, 2010

 +2       ;

 +3       ;

GTMP(DATA,DFN) ; EP -- AGG GET TEMP PAT HRN

 +1       ;

 +2        NEW UID,II,THRN

 +3        SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)

 +4        SET DATA=$NAME(^TMP("AGGPTHRN",UID))

 +5        KILL @DATA

 +6        SET II=0

 +7       ; SAC 2006 2.2.3.3.2

           NEW $ESTACK,$ETRAP

           SET $ETRAP="D ERR^AGGWDISP D UNWIND^%ZTER"

 +8        SET @DATA@(II)="T00010AGGPTHRN"_$CHAR(30)

 +9        SET THRN=$$THRN()

 +10       SET ^AUPNPAT("D",THRN,DFN,DUZ(2))=""

 +11       SET II=II+1

           SET @DATA@(II)=THRN_$CHAR(30)

 +12       SET II=II+1

           SET @DATA@(II)=$CHAR(31)

 +13       QUIT 

 +14      ;

THRN()    ;EP - Get a temporary HRN number

 +1        NEW AGCH,AGTCH

 +2        SET AGCH=999999

 +3        SET AGTCH=0

           SET QFL=0

 +4        FOR I=0:0

               SET AGCH=$ORDER(^AUPNPAT("D",AGCH))

               IF AGCH=""

                   QUIT 

               Begin DoDot:1

 +5                IF $DATA(^AUPNPAT("D",AGCH,DFN))

                       SET AGTCH=AGCH

                       SET QFL=1

 +6                SET AGTCH=AGCH

               End DoDot:1

               IF QFL

                   QUIT 

 +7       ;

 +8        IF 'QFL

               Begin DoDot:1

 +9                IF AGTCH=0

                       SET AGTCH="T00000"

 +10               SET AGTCH=$EXTRACT(AGTCH,2,6)

 +11               SET AGTCH=AGTCH+1

 +12               SET AGTCH="T"_$EXTRACT(100000+AGTCH,2,6)

               End DoDot:1

 +13       QUIT AGTCH