- AG5 ; IHS/ASDS/EFG - ENTER MEDICAID DATA ;
- ;;7.1;PATIENT REGISTRATION;**2**;JAN 31, 2007
- ;
- L1 I AGOPT(4)'="Y" G ^AG6
- I $D(^AUPNMCD("AB",DFN)) D Q
- . W !!,"Any more MEDICAID COVERAGE? (Y/N) NO// "
- . S AG("DFLT")="YES"
- . G L2
- S AG("DFLT")="NO"
- W !!,"Does this patient have MEDICAID COVERAGE? (Y/N) NO// "
- L2 D READ^AG
- S AG("LT")=$S($E(Y)="Y":"YES",1:"NO")
- ;TESTING USE OF EDIT SCREEN FOR ADDING INSURANCE TO NEW PATIENT 5/13/2005
- I $G(^AGFAC(DUZ(2),"NEWADDINS")) I AG("LT")="YES" S AGPAT=$P($G(^DPT(DFN,0)),U) S AGXTERN=1 D EN^AGEDMCD("","",1,"",XQY0) K AGXTERN G:$G(NEWENTRY)=0 ^AG6 G L1
- I $G(^AGFAC(DUZ(2),"NEWADDINS")),$D(DUOUT) G DUOUT^AG4
- I $G(^AGFAC(DUZ(2),"NEWADDINS")),($G(AG("LT"))="NO") G ^AG6
- ;TESTING
- Q:$D(DTOUT)!$D(DFOUT)
- G DUOUT^AG4:$D(DUOUT)
- G STATE:Y?1"Y".E,END:Y?1"N".E!$D(DLOUT)
- D YN^AG
- G L1
- ADDNEW ;EP - Add/Edit MediCAID Client.
- STATE ;EP - STATE LOOP
- W !!,"Enter the MEDICAID STATE: "
- D READ^AG
- ;I $D(DUOUT)!$D(DFOUT)!$D(DLOUT)!$D(DTOUT)!$D(DQOUT)!$D(DIRUT)!(Y=" ") W !,"This is a required field." G STATE
- I $D(DUOUT)!$D(DFOUT)!$D(DLOUT)!$D(DTOUT)!(Y=" ") W !,"This is a required field." G STATE ;AG*7.1*2 PROBLEM REPORTED DURING ALPHA TESTING
- I $D(DQOUT) D
- . S AG("ST")=0
- . W !!,"Enter the Medicaid account state."
- . W:$D(^AUPNMCD("AB",DFN)) " The following are on file:"
- . F AGZ("I")=1:1 S AG("ST")=$O(^AUPNMCD("AB",DFN,AG("ST"))) G:AG("ST")="" STATE W !,$P(^DIC(5,AG("ST"),0),U)
- S X=Y
- S DIC=5
- S DIC(0)="QEM"
- D ^DIC
- G STATE:+Y<1
- S AG("STATE")=+Y
- I $D(AG("STPTR")) S $P(^AUPNMCD(AGELPTR,0),U,4)=+Y
- Q:$D(AG("STPTR"))
- NUMB W !!,"Enter the MEDICAID NUMBER: "
- D READ^AG
- I $D(DLOUT) W !,"This is a Required field" G NUMB
- I $D(DUOUT)!$D(DTOUT)!$D(DFOUT) W !,"This is a Required field" G NUMB ;AG*7.1*2 REPORTED DURING ALPHA
- G ^AGED4A:$D(DUOUT)!$D(DTOUT)!$D(DFOUT)
- I $D(DQOUT) D
- .S I=""
- . F AGZ("I")=1:1 S I=$O(^AUPNMCD("AB",DFN,AG("STATE"),I)) Q:I="" W !,I
- S (X,AG("NUM"))=Y
- X $P(^DD(9000004,.03,0),U,5,99) I '$D(X) W !,^(3) G NUMB
- L5 ;
- LOCK ^AUPNMCD(0)
- S (D,DA)=$P(^AUPNMCD(0),"^",3)
- F AGZ("I")=1:1 S D=$O(^AUPNMCD(D)) Q:D=""!(D]"@") S DA=D
- K D
- S DA=DA+1
- S ^AUPNMCD(DA,0)=DFN_U_$O(^AUTNINS("B","MEDICAID",0))
- S ^AUPNMCD("B",DFN,DA)=""
- S $P(^AUPNMCD(0),U,3)=DA
- S $P(^AUPNMCD(0),U,4)=$P(^AUPNMCD(0),U,4)+1
- LOCK
- S AG("MCD")=DA
- S DIE="^AUPNMCD("
- S DR=".03///"_AG("NUM")_";.04///"_$P(^DIC(5,AG("STATE"),0),U)
- D ^DIE
- S AGELPTR=DA
- S ADDCHK=""
- L6 G MCNM:'$D(^DD(9000004,.05)) W !!,"Enter the NAME OF THE INSURED person.",!,"(Enter SAME if the PATIENT is the primary insured person.)",!!,"? " W:$P(^AUPNMCD(AG("MCD"),0),U,5)]"" " ",$P(^AUPNMCD(AG("MCD"),0),U,5),"// " D READ^AG
- I $D(DQOUT) W !!,"Enter the name of the person in whose name the main account is carried.",!,"The name must be in the same format as the patient names.",!!,"If the patient is the primary insured person, enter SAME.",!! G L6
- G REL:$D(DLOUT)&($P(^AUPNMCD(AG("MCD"),0),U,5)]""),L6:Y="" I Y="SAME" D SAME G L6:$P(^AUPNMCD(AG("MCD"),0),U,5)="" G MCNM
- S DIE("NO^")="",DR=".05///"_Y,DA=AG("MCD"),DIE="^AUPNMCD(" D ^DIE G L6:$P(^AUPNMCD(AG("MCD"),0),U,5)=""
- REL ;
- S DIC="^AUTTRLSH("
- S DIC(0)="QAZEM"
- S DIC("A")="Enter PATIENT'S RELATIONSHIP to the insured: "
- W !
- D ^DIC
- G REL:+Y<1
- S DA=AG("MCD")
- S $P(^AUPNMCD(DA,0),U,6)=+Y
- K DIC("S"),DIC("A")
- SEX W !
- S DIE="^AUPNMCD("
- S DA=AG("MCD")
- S DR=.07
- S DIE("NO^")=""
- D ^DIE
- MCNM ;
- I $P($G(^AUPNMCD(AG("MCD"),21)),U)="" D
- . S DR=2101
- . D ^DIE
- PCP W !
- S DIE="^AUPNMCD("
- S DA=AG("MCD")
- S DR=.14
- D ^DIE
- GROUP W !
- S DIE="^AUPNMCD("
- S DA=AG("MCD")
- S DR=.17
- D ^DIE
- CC W !
- S DIE="^AUPNMCD("
- S DA=AG("MCD")
- S DR=.15
- D ^DIE
- CCD W !
- S DIE="^AUPNMCD("
- S DA=AG("MCD")
- S DR=.16
- D ^DIE
- I '$D(^AUPNMCD(AG("MCD"),21)) G MCDB
- D:$P(^AUPNMCD(AG("MCD"),21),U)]"" SETOTHER G MCDB
- SETOTHER ;
- Q
- MCDB ;
- I $P($G(^AUPNMCD(AG("MCD"),21)),U,2)="" D
- . S DR=2102
- . D ^DIE
- . W !
- ;
- K DIC("DR"),DR
- S DIE("NO^")=""
- S DR="1101R",DIE="^AUPNMCD(",DA=AG("MCD")
- D ^DIE
- D:$D(AG("EDIT")) UPDATE^AGED5
- I '$D(AG("EDIT")) K DR S DR=".08///"_DT,DA=AG("MCD"),DIE="^AUPNMCD(" D ^DIE
- K DR
- W !
- S DR=".11;.12"
- D ^DIE
- END Q:$D(AG("EDIT"))
- K AG G ^AG6
- SAME S DR=".05///"_$P(^DPT(DFN,0),U)
- S DIE="^AUPNMCD("
- D ^DIE
- S DR=".07///"_$P(^DPT(DFN,0),U,2)_";.06///SELF"
- D ^DIE
- S DR="2101///"_$P(^DPT(DFN,0),U)
- D ^DIE
- S DR="2102///"_$P($G(^DPT(DFN,0)),U,3)
- D ^DIE
- Q
- DUOUT ;EP
- G L1:AGOPT(4)="Y",DUOUT^AG4
- AG5 ; IHS/ASDS/EFG - ENTER MEDICAID DATA ;
- +1 ;;7.1;PATIENT REGISTRATION;**2**;JAN 31, 2007
- +2 ;
- L1 IF AGOPT(4)'="Y"
- GOTO ^AG6
- +1 IF $DATA(^AUPNMCD("AB",DFN))
- Begin DoDot:1
- +2 WRITE !!,"Any more MEDICAID COVERAGE? (Y/N) NO// "
- +3 SET AG("DFLT")="YES"
- +4 GOTO L2
- End DoDot:1
- QUIT
- +5 SET AG("DFLT")="NO"
- +6 WRITE !!,"Does this patient have MEDICAID COVERAGE? (Y/N) NO// "
- L2 DO READ^AG
- +1 SET AG("LT")=$SELECT($EXTRACT(Y)="Y":"YES",1:"NO")
- +2 ;TESTING USE OF EDIT SCREEN FOR ADDING INSURANCE TO NEW PATIENT 5/13/2005
- +3 IF $GET(^AGFAC(DUZ(2),"NEWADDINS"))
- IF AG("LT")="YES"
- SET AGPAT=$PIECE($GET(^DPT(DFN,0)),U)
- SET AGXTERN=1
- DO EN^AGEDMCD("","",1,"",XQY0)
- KILL AGXTERN
- IF $GET(NEWENTRY)=0
- GOTO ^AG6
- GOTO L1
- +4 IF $GET(^AGFAC(DUZ(2),"NEWADDINS"))
- IF $DATA(DUOUT)
- GOTO DUOUT^AG4
- +5 IF $GET(^AGFAC(DUZ(2),"NEWADDINS"))
- IF ($GET(AG("LT"))="NO")
- GOTO ^AG6
- +6 ;TESTING
- +7 IF $DATA(DTOUT)!$DATA(DFOUT)
- QUIT
- +8 IF $DATA(DUOUT)
- GOTO DUOUT^AG4
- +9 IF Y?1"Y".E
- GOTO STATE
- IF Y?1"N".E!$DATA(DLOUT)
- GOTO END
- +10 DO YN^AG
- +11 GOTO L1
- ADDNEW ;EP - Add/Edit MediCAID Client.
- STATE ;EP - STATE LOOP
- +1 WRITE !!,"Enter the MEDICAID STATE: "
- +2 DO READ^AG
- +3 ;I $D(DUOUT)!$D(DFOUT)!$D(DLOUT)!$D(DTOUT)!$D(DQOUT)!$D(DIRUT)!(Y=" ") W !,"This is a required field." G STATE
- +4 ;AG*7.1*2 PROBLEM REPORTED DURING ALPHA TESTING
- IF $DATA(DUOUT)!$DATA(DFOUT)!$DATA(DLOUT)!$DATA(DTOUT)!(Y=" ")
- WRITE !,"This is a required field."
- GOTO STATE
- +5 IF $DATA(DQOUT)
- Begin DoDot:1
- +6 SET AG("ST")=0
- +7 WRITE !!,"Enter the Medicaid account state."
- +8 IF $DATA(^AUPNMCD("AB",DFN))
- WRITE " The following are on file:"
- +9 FOR AGZ("I")=1:1
- SET AG("ST")=$ORDER(^AUPNMCD("AB",DFN,AG("ST")))
- IF AG("ST")=""
- GOTO STATE
- WRITE !,$PIECE(^DIC(5,AG("ST"),0),U)
- End DoDot:1
- +10 SET X=Y
- +11 SET DIC=5
- +12 SET DIC(0)="QEM"
- +13 DO ^DIC
- +14 IF +Y<1
- GOTO STATE
- +15 SET AG("STATE")=+Y
- +16 IF $DATA(AG("STPTR"))
- SET $PIECE(^AUPNMCD(AGELPTR,0),U,4)=+Y
- +17 IF $DATA(AG("STPTR"))
- QUIT
- NUMB WRITE !!,"Enter the MEDICAID NUMBER: "
- +1 DO READ^AG
- +2 IF $DATA(DLOUT)
- WRITE !,"This is a Required field"
- GOTO NUMB
- +3 ;AG*7.1*2 REPORTED DURING ALPHA
- IF $DATA(DUOUT)!$DATA(DTOUT)!$DATA(DFOUT)
- WRITE !,"This is a Required field"
- GOTO NUMB
- +4 IF $DATA(DUOUT)!$DATA(DTOUT)!$DATA(DFOUT)
- GOTO ^AGED4A
- +5 IF $DATA(DQOUT)
- Begin DoDot:1
- +6 SET I=""
- +7 FOR AGZ("I")=1:1
- SET I=$ORDER(^AUPNMCD("AB",DFN,AG("STATE"),I))
- IF I=""
- QUIT
- WRITE !,I
- End DoDot:1
- +8 SET (X,AG("NUM"))=Y
- +9 XECUTE $PIECE(^DD(9000004,.03,0),U,5,99)
- IF '$DATA(X)
- WRITE !,^(3)
- GOTO NUMB
- L5 ;
- +1 LOCK ^AUPNMCD(0)
- +2 SET (D,DA)=$PIECE(^AUPNMCD(0),"^",3)
- +3 FOR AGZ("I")=1:1
- SET D=$ORDER(^AUPNMCD(D))
- IF D=""!(D]"@")
- QUIT
- SET DA=D
- +4 KILL D
- +5 SET DA=DA+1
- +6 SET ^AUPNMCD(DA,0)=DFN_U_$ORDER(^AUTNINS("B","MEDICAID",0))
- +7 SET ^AUPNMCD("B",DFN,DA)=""
- +8 SET $PIECE(^AUPNMCD(0),U,3)=DA
- +9 SET $PIECE(^AUPNMCD(0),U,4)=$PIECE(^AUPNMCD(0),U,4)+1
- +10 LOCK
- +11 SET AG("MCD")=DA
- +12 SET DIE="^AUPNMCD("
- +13 SET DR=".03///"_AG("NUM")_";.04///"_$PIECE(^DIC(5,AG("STATE"),0),U)
- +14 DO ^DIE
- +15 SET AGELPTR=DA
- +16 SET ADDCHK=""
- L6 IF '$DATA(^DD(9000004,.05))
- GOTO MCNM
- WRITE !!,"Enter the NAME OF THE INSURED person.",!,"(Enter SAME if the PATIENT is the primary insured person.)",!!,"? "
- IF $PIECE(^AUPNMCD(AG("MCD"),0),U,5)]""
- WRITE " ",$PIECE(^AUPNMCD(AG("MCD"),0),U,5),"// "
- DO READ^AG
- +1 IF $DATA(DQOUT)
- WRITE !!,"Enter the name of the person in whose name the main account is carried.",!,"The name must be in the same format as the patient names.",!!,"If the patient is the primary insured person, enter SAME.",!!
- GOTO L6
- +2 IF $DATA(DLOUT)&($PIECE(^AUPNMCD(AG("MCD"),0),U,5)]"")
- GOTO REL
- IF Y=""
- GOTO L6
- IF Y="SAME"
- DO SAME
- IF $PIECE(^AUPNMCD(AG("MCD"),0),U,5)=""
- GOTO L6
- GOTO MCNM
- +3 SET DIE("NO^")=""
- SET DR=".05///"_Y
- SET DA=AG("MCD")
- SET DIE="^AUPNMCD("
- DO ^DIE
- IF $PIECE(^AUPNMCD(AG("MCD"),0),U,5)=""
- GOTO L6
- REL ;
- +1 SET DIC="^AUTTRLSH("
- +2 SET DIC(0)="QAZEM"
- +3 SET DIC("A")="Enter PATIENT'S RELATIONSHIP to the insured: "
- +4 WRITE !
- +5 DO ^DIC
- +6 IF +Y<1
- GOTO REL
- +7 SET DA=AG("MCD")
- +8 SET $PIECE(^AUPNMCD(DA,0),U,6)=+Y
- +9 KILL DIC("S"),DIC("A")
- SEX WRITE !
- +1 SET DIE="^AUPNMCD("
- +2 SET DA=AG("MCD")
- +3 SET DR=.07
- +4 SET DIE("NO^")=""
- +5 DO ^DIE
- MCNM ;
- +1 IF $PIECE($GET(^AUPNMCD(AG("MCD"),21)),U)=""
- Begin DoDot:1
- +2 SET DR=2101
- +3 DO ^DIE
- End DoDot:1
- PCP WRITE !
- +1 SET DIE="^AUPNMCD("
- +2 SET DA=AG("MCD")
- +3 SET DR=.14
- +4 DO ^DIE
- GROUP WRITE !
- +1 SET DIE="^AUPNMCD("
- +2 SET DA=AG("MCD")
- +3 SET DR=.17
- +4 DO ^DIE
- CC WRITE !
- +1 SET DIE="^AUPNMCD("
- +2 SET DA=AG("MCD")
- +3 SET DR=.15
- +4 DO ^DIE
- CCD WRITE !
- +1 SET DIE="^AUPNMCD("
- +2 SET DA=AG("MCD")
- +3 SET DR=.16
- +4 DO ^DIE
- +5 IF '$DATA(^AUPNMCD(AG("MCD"),21))
- GOTO MCDB
- +6 IF $PIECE(^AUPNMCD(AG("MCD"),21),U)]""
- DO SETOTHER
- GOTO MCDB
- SETOTHER ;
- +1 QUIT
- MCDB ;
- +1 IF $PIECE($GET(^AUPNMCD(AG("MCD"),21)),U,2)=""
- Begin DoDot:1
- +2 SET DR=2102
- +3 DO ^DIE
- +4 WRITE !
- End DoDot:1
- +5 ;
- +6 KILL DIC("DR"),DR
- +7 SET DIE("NO^")=""
- +8 SET DR="1101R"
- SET DIE="^AUPNMCD("
- SET DA=AG("MCD")
- +9 DO ^DIE
- +10 IF $DATA(AG("EDIT"))
- DO UPDATE^AGED5
- +11 IF '$DATA(AG("EDIT"))
- KILL DR
- SET DR=".08///"_DT
- SET DA=AG("MCD")
- SET DIE="^AUPNMCD("
- DO ^DIE
- +12 KILL DR
- +13 WRITE !
- +14 SET DR=".11;.12"
- +15 DO ^DIE
- END IF $DATA(AG("EDIT"))
- QUIT
- +1 KILL AG
- GOTO ^AG6
- SAME SET DR=".05///"_$PIECE(^DPT(DFN,0),U)
- +1 SET DIE="^AUPNMCD("
- +2 DO ^DIE
- +3 SET DR=".07///"_$PIECE(^DPT(DFN,0),U,2)_";.06///SELF"
- +4 DO ^DIE
- +5 SET DR="2101///"_$PIECE(^DPT(DFN,0),U)
- +6 DO ^DIE
- +7 SET DR="2102///"_$PIECE($GET(^DPT(DFN,0)),U,3)
- +8 DO ^DIE
- +9 QUIT
- DUOUT ;EP
- +1 IF AGOPT(4)="Y"
- GOTO L1
- GOTO DUOUT^AG4
