AGCNVBEN.m

AGCNVBEN ; IHS/ASDS/TPF - CONVERT OLD BENEFIT COORDINATOR SUBFILE IN PATIENT FILE TO NEW BENEFIT COORDINATOR FILE

 ;;7.1;PATIENT REGISTRATION;;AUG 25,2005

 ;

START ;

 S PDFN=0

 F  S PDFN=$O(^AUPNPAT(PDFN)) Q:'PDFN  D GETDATA(PDFN)

 Q

GETDATA(PDFN) ;EP

 Q:'$O(^AUPNPAT(PDFN,33,0))  ;QUITE IF NO DATA TO MOVE

 K DIC,DIE

 S X="`"_PDFN S DIC(0)="L" S DIC=9000044 D ^DIC

 Q:Y<0  ;COULD NOT CREATE ENTRY

 I $D(^AUPNBENR(+Y,11)) W !,"BENEFIT DATA ALREADY MOVED" Q

 ;ENTRY CREATED LETS MOVE THE DATA

 M ^AUPNBENR(+Y,11)=^AUPNPAT(PDFN,33)

 S $P(^AUPNBENR(+Y,11,0),U,2)=9000044.11   ;RESET SUBFILE NUMBER

 Q

AGCNVBEN  ; IHS/ASDS/TPF - CONVERT OLD BENEFIT COORDINATOR SUBFILE IN PATIENT FILE TO NEW BENEFIT COORDINATOR FILE

 +1       ;;7.1;PATIENT REGISTRATION;;AUG 25,2005

 +2       ;

START     ;

 +1        SET PDFN=0

 +2        FOR 

               SET PDFN=$ORDER(^AUPNPAT(PDFN))

               IF 'PDFN

                   QUIT 

               DO GETDATA(PDFN)

 +3        QUIT 

GETDATA(PDFN) ;EP

 +1       ;QUITE IF NO DATA TO MOVE

           IF '$ORDER(^AUPNPAT(PDFN,33,0))

               QUIT 

 +2        KILL DIC,DIE

 +3        SET X="`"_PDFN

           SET DIC(0)="L"

           SET DIC=9000044

           DO ^DIC

 +4       ;COULD NOT CREATE ENTRY

           IF Y<0

               QUIT 

 +5        IF $DATA(^AUPNBENR(+Y,11))

               WRITE !,"BENEFIT DATA ALREADY MOVED"

               QUIT 

 +6       ;ENTRY CREATED LETS MOVE THE DATA

 +7        MERGE ^AUPNBENR(+Y,11)=^AUPNPAT(PDFN,33)

 +8       ;RESET SUBFILE NUMBER

           SET $PIECE(^AUPNBENR(+Y,11,0),U,2)=9000044.11

 +9        QUIT