- 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
