AGCNVMOD.m

AGCNVMOD ;IHS/SD/EFG - CONVERT AUPNPAT FIELD 3401 TO A POINTER ;   

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

 ;

EMOD ;CHANGE FIELD 3401 OF AUPNPAT TO USE POINTER TO ELIGIBILITY

 ;MODIFIER FILE NOT DESCRIPTION

 K AG("DFN"),AG("MODPTR")

 S AG("DFN")=0

 F  S AG("DFN")=$O(^AUPNPAT(AG("DFN"))) Q:'AG("DFN")  D

 . Q:'$D(^AUPNPAT(AG("DFN"),34,0))

 . S AG("MODPTR")=0

 . F  S AG("MODPTR")=$O(^AUPNPAT(AG("DFN"),34,AG("MODPTR"))) Q:'AG("MODPTR")  D

 . . Q:$P(^AUPNPAT(AG("DFN"),34,AG("MODPTR"),0),U)>0

 . . D FIXMOD

 Q

FIXMOD ;CHANGE .01 FIELD TO A POINTER

 S DA(1)=AG("DFN")

 S DA=AG("MODPTR")

 S DIK="^AUPNPAT("_DA(1)_",34,"

 D ^DIK

 N DA,DIC,DD,DLAYGO,DO,X,Y

 K DD,DO

 S X=AG("MODPTR")

 S DINUM=+AG("MODPTR")

 S DA(1)=AG("DFN")

 S DIC="^AUPNPAT("_DA(1)_",34,"

 S DIC(0)="L"

 S DIC("P")=$P($G(^DD(9000001,3401,0)),U,2)

 S DLAYGO=9000001.03401

 D FILE^DICN

 Q

AGCNVMOD  ;IHS/SD/EFG - CONVERT AUPNPAT FIELD 3401 TO A POINTER ;   

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

 +2       ;

EMOD      ;CHANGE FIELD 3401 OF AUPNPAT TO USE POINTER TO ELIGIBILITY

 +1       ;MODIFIER FILE NOT DESCRIPTION

 +2        KILL AG("DFN"),AG("MODPTR")

 +3        SET AG("DFN")=0

 +4        FOR 

               SET AG("DFN")=$ORDER(^AUPNPAT(AG("DFN")))

               IF 'AG("DFN")

                   QUIT 

               Begin DoDot:1

 +5                IF '$DATA(^AUPNPAT(AG("DFN"),34,0))

                       QUIT 

 +6                SET AG("MODPTR")=0

 +7                FOR 

                       SET AG("MODPTR")=$ORDER(^AUPNPAT(AG("DFN"),34,AG("MODPTR")))

                       IF 'AG("MODPTR")

                           QUIT 

                       Begin DoDot:2

 +8                        IF $PIECE(^AUPNPAT(AG("DFN"),34,AG("MODPTR"),0),U)>0

                               QUIT 

 +9                        DO FIXMOD

                       End DoDot:2

               End DoDot:1

 +10       QUIT 

FIXMOD    ;CHANGE .01 FIELD TO A POINTER

 +1        SET DA(1)=AG("DFN")

 +2        SET DA=AG("MODPTR")

 +3        SET DIK="^AUPNPAT("_DA(1)_",34,"

 +4        DO ^DIK

 +5        NEW DA,DIC,DD,DLAYGO,DO,X,Y

 +6        KILL DD,DO

 +7        SET X=AG("MODPTR")

 +8        SET DINUM=+AG("MODPTR")

 +9        SET DA(1)=AG("DFN")

 +10       SET DIC="^AUPNPAT("_DA(1)_",34,"

 +11       SET DIC(0)="L"

 +12       SET DIC("P")=$PIECE($GET(^DD(9000001,3401,0)),U,2)

 +13       SET DLAYGO=9000001.03401

 +14       DO FILE^DICN

 +15       QUIT