AGMSPINT.m

AGMSPINT ; IHS/SD/EFG - ROUTINE FOR MSP INTERVIEW PROCESS ;

 ;;7.1;PATIENT REGISTRATION;**4,8**;AUG 25, 2005

 ;

EN K DIC

 D PTLK^AG

 Q:'$D(DFN)

 D CLEAR  ;CLEAR ALL QUESTION RESULTS VARIABLES

 K DIC,Y,DD,DO,DIR,DIE,DR

 S DIC="^AUPNMSP("

 S DIC(0)="AELQMZ"

 S DIC("DR")=""

 S DIC("S")="I $P($G(^AUPNMSP(Y,0)),U,2)=$G(AUPNPAT)"

 D ^DIC

 Q:Y<0

 S AG("DA")=+Y

 S DA=+Y

 S DIE=DIC

 K DR,DIC,DIR

 S DR=".02////"_DFN

 D ^DIE

 K DIC

 D ^XBCLS

PROCESS ;

 S AG("MCRCHK")=""

 D HDR

 D EN^AGMSPI1

 Q:$D(Y)                                                                         ;AG*7.1*8

 D ASKSIGDT

 K AG("DA"),DIE,DIC,DIR

 Q

 ;ASK FOR SIGNATURE DATE

ASKSIGDT ;EP

 ;BEGIN AG*7.1*4 SCR

 W !!

 S DA=AG("DA")

 S DR=".03R;S:X=""N"" Y=0;.04R"

 D ^DIE

 Q:$D(Y)                                               ;AG*7.1*8

 ;END

 S DA=AG("DA")

 S DR=100

 D ^DIE

 Q

 ;ADD SIGNATURE ONLY

ADDSIG ;EP - CALLED FROM OPTION 'AG ADD MSP SIGNATURE DATE'

 K DIC,Y,DD,DO

 S DIC="^AUPNMSP("

 S DIC(0)="AEMQZ"

 S DIC("S")="I $P($G(^(7)),U)="""""

 D ^DIC Q:Y=-1

 S AG("DA")=+Y

 K DIC

 D ^XBCLS

 S DIE="^AUPNMSP("

 D ASKSIGDT

 K AG("DA"),DIE,DIC,DIR

 Q

HDR ;

 S AGPAT=$P(^DPT(DFN,0),U)

 S AGCHRT=$S($D(^AUPNPAT(DFN,41,DUZ(2),0)):$P(^AUPNPAT(DFN,41,DUZ(2),0),U,2),1:"xxxxx")

 S Y=DT D DD^%DT S AG("TODAY")=Y

 S AGLINE("-")=$TR($J(" ",79)," ","-")

 S AGLINE("EQ")=$TR($J(" ",79)," ","=")

 S AGLINE("_")=$TR($J(" ",79)," ","_")

 W !,?10,"WARNING: Confidential Patient Information, Privacy Act Applies"

 W !,AGLINE("EQ")

 W !,?18,"MEDICARE SECONDARY PAYER QUESTIONNAIRE INTERVIEW"

 W !,AGLINE("-")

 W !,AGPAT,"  (",AGCHRT,")"

 W ?53,"TODAY'S DATE: ",AG("TODAY")

 W !,AGLINE("EQ"),!

 Q

CLEAR ;EP

 K PARTI1,PARTI2,PARTI3,PARTI4

 K PARTII1,PARTII2,PARTII3

 K PARTIII1

 K PARTIV1,PARTIV2,PARTIV3,PARTIV4

 K PARTV1,PARTV2,PARTV3,PARTV4

 K PARTVI1,PARTVI2,PARTVI3,PARTVI4,PARTIV5,PARTVI6,PARTVI7

 Q

AGMSPINT  ; IHS/SD/EFG - ROUTINE FOR MSP INTERVIEW PROCESS ;

 +1       ;;7.1;PATIENT REGISTRATION;**4,8**;AUG 25, 2005

 +2       ;

EN         KILL DIC

 +1        DO PTLK^AG

 +2        IF '$DATA(DFN)

               QUIT 

 +3       ;CLEAR ALL QUESTION RESULTS VARIABLES

           DO CLEAR

 +4        KILL DIC,Y,DD,DO,DIR,DIE,DR

 +5        SET DIC="^AUPNMSP("

 +6        SET DIC(0)="AELQMZ"

 +7        SET DIC("DR")=""

 +8        SET DIC("S")="I $P($G(^AUPNMSP(Y,0)),U,2)=$G(AUPNPAT)"

 +9        DO ^DIC

 +10       IF Y<0

               QUIT 

 +11       SET AG("DA")=+Y

 +12       SET DA=+Y

 +13       SET DIE=DIC

 +14       KILL DR,DIC,DIR

 +15       SET DR=".02////"_DFN

 +16       DO ^DIE

 +17       KILL DIC

 +18       DO ^XBCLS

PROCESS   ;

 +1        SET AG("MCRCHK")=""

 +2        DO HDR

 +3        DO EN^AGMSPI1

 +4       ;AG*7.1*8

           IF $DATA(Y)

               QUIT 

 +5        DO ASKSIGDT

 +6        KILL AG("DA"),DIE,DIC,DIR

 +7        QUIT 

 +8       ;ASK FOR SIGNATURE DATE

ASKSIGDT  ;EP

 +1       ;BEGIN AG*7.1*4 SCR

 +2        WRITE !!

 +3        SET DA=AG("DA")

 +4        SET DR=".03R;S:X=""N"" Y=0;.04R"

 +5        DO ^DIE

 +6       ;AG*7.1*8

           IF $DATA(Y)

               QUIT 

 +7       ;END

 +8        SET DA=AG("DA")

 +9        SET DR=100

 +10       DO ^DIE

 +11       QUIT 

 +12      ;ADD SIGNATURE ONLY

ADDSIG    ;EP - CALLED FROM OPTION 'AG ADD MSP SIGNATURE DATE'

 +1        KILL DIC,Y,DD,DO

 +2        SET DIC="^AUPNMSP("

 +3        SET DIC(0)="AEMQZ"

 +4        SET DIC("S")="I $P($G(^(7)),U)="""""

 +5        DO ^DIC

           IF Y=-1

               QUIT 

 +6        SET AG("DA")=+Y

 +7        KILL DIC

 +8        DO ^XBCLS

 +9        SET DIE="^AUPNMSP("

 +10       DO ASKSIGDT

 +11       KILL AG("DA"),DIE,DIC,DIR

 +12       QUIT 

HDR       ;

 +1        SET AGPAT=$PIECE(^DPT(DFN,0),U)

 +2        SET AGCHRT=$SELECT($DATA(^AUPNPAT(DFN,41,DUZ(2),0)):$PIECE(^AUPNPAT(DFN,41,DUZ(2),0),U,2),1:"xxxxx")

 +3        SET Y=DT

           DO DD^%DT

           SET AG("TODAY")=Y

 +4        SET AGLINE("-")=$TRANSLATE($JUSTIFY(" ",79)," ","-")

 +5        SET AGLINE("EQ")=$TRANSLATE($JUSTIFY(" ",79)," ","=")

 +6        SET AGLINE("_")=$TRANSLATE($JUSTIFY(" ",79)," ","_")

 +7        WRITE !,?10,"WARNING: Confidential Patient Information, Privacy Act Applies"

 +8        WRITE !,AGLINE("EQ")

 +9        WRITE !,?18,"MEDICARE SECONDARY PAYER QUESTIONNAIRE INTERVIEW"

 +10       WRITE !,AGLINE("-")

 +11       WRITE !,AGPAT,"  (",AGCHRT,")"

 +12       WRITE ?53,"TODAY'S DATE: ",AG("TODAY")

 +13       WRITE !,AGLINE("EQ"),!

 +14       QUIT 

CLEAR     ;EP

 +1        KILL PARTI1,PARTI2,PARTI3,PARTI4

 +2        KILL PARTII1,PARTII2,PARTII3

 +3        KILL PARTIII1

 +4        KILL PARTIV1,PARTIV2,PARTIV3,PARTIV4

 +5        KILL PARTV1,PARTV2,PARTV3,PARTV4

 +6        KILL PARTVI1,PARTVI2,PARTVI3,PARTVI4,PARTIV5,PARTVI6,PARTVI7

 +7        QUIT