AGGINSUR.m

AGGINSUR ;VNGT/HS/ALA-Insurance Data ; 29 Apr 2010  4:32 PM

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

 ;

GET(DATA,INIEN) ; EP -- AGG GET INSURANCE DATA

 NEW UID,II

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

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

 K @DATA

 ;

 S II=0

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

 S @DATA@(II)="I00010IEN^T00030NAME^T00030STREET^T00015CITY^T00030STATE^T00010ZIP^T00015PHONE^T00015STATUS^T00025TYPE"_$C(30)

 I $G(INIEN)="" D

 . S IIEN=0

 . F  S IIEN=$O(^AUTNINS(IIEN)) Q:'IIEN  D RET(IIEN)

 ;

 I $G(INIEN)'="" D RET(INIEN)

 ;

DONE ;

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

 Q

 ;

RET(IIEN) ;

 S STATUS=$P($G(^AUTNINS(IIEN,1)),"^",7),STATUS=$$STC^AGGUL1(9999999.18,.17,STATUS)

 S INS=^AUTNINS(IIEN,0)

 S ST=$P(INS,U,4) I ST'="" S ST=$P(^DIC(5,ST,0),U,1)

 S TYP=$P($G(^AUTNINS(IIEN,2)),U,1),TYP=$$STC^AGGUL1(9999999.18,.21,TYP)

 S II=II+1,@DATA@(II)=IIEN_U_$P(INS,U,1)_U_$P(INS,U,2)_U_$P(INS,U,3)_U_ST_U_$P(INS,U,5)_U_$P(INS,U,6)_U_STATUS_U_TYP_$C(30)

 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

AGGINSUR  ;VNGT/HS/ALA-Insurance Data ; 29 Apr 2010  4:32 PM

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

 +2       ;

GET(DATA,INIEN) ; EP -- AGG GET INSURANCE DATA

 +1        NEW UID,II

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

 +3        SET DATA=$NAME(^TMP("AGGINSUR",UID))

 +4        KILL @DATA

 +5       ;

 +6        SET II=0

 +7       ; SAC 2006 2.2.3.3.2

           NEW $ESTACK,$ETRAP

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

 +8        SET @DATA@(II)="I00010IEN^T00030NAME^T00030STREET^T00015CITY^T00030STATE^T00010ZIP^T00015PHONE^T00015STATUS^T00025TYPE"_$CHAR(30)

 +9        IF $GET(INIEN)=""

               Begin DoDot:1

 +10               SET IIEN=0

 +11               FOR 

                       SET IIEN=$ORDER(^AUTNINS(IIEN))

                       IF 'IIEN

                           QUIT 

                       DO RET(IIEN)

               End DoDot:1

 +12      ;

 +13       IF $GET(INIEN)'=""

               DO RET(INIEN)

 +14      ;

DONE      ;

 +1        SET II=II+1

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

 +2        QUIT 

 +3       ;

RET(IIEN) ;

 +1        SET STATUS=$PIECE($GET(^AUTNINS(IIEN,1)),"^",7)

           SET STATUS=$$STC^AGGUL1(9999999.18,.17,STATUS)

 +2        SET INS=^AUTNINS(IIEN,0)

 +3        SET ST=$PIECE(INS,U,4)

           IF ST'=""

               SET ST=$PIECE(^DIC(5,ST,0),U,1)

 +4        SET TYP=$PIECE($GET(^AUTNINS(IIEN,2)),U,1)

           SET TYP=$$STC^AGGUL1(9999999.18,.21,TYP)

 +5        SET II=II+1

           SET @DATA@(II)=IIEN_U_$PIECE(INS,U,1)_U_$PIECE(INS,U,2)_U_$PIECE(INS,U,3)_U_ST_U_$PIECE(INS,U,5)_U_$PIECE(INS,U,6)_U_STATUS_U_TYP_$CHAR(30)

 +6        QUIT 

 +7       ;

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