AG7.m

AG7 ; IHS/ASDS/EFG - ENTER PRIVATE INSURANCE DATA ;   

 ;;7.1;PATIENT REGISTRATION;**1,2,3,12**;AUG 25, 2005;Build 1

 ;

 ;IHS/OIT/NKD AG*7.1*12 INSURER TYPE

 ;

L1 K AGADD

 I AGOPT(5)'="Y" G ^AG8

 S AG("DFLT")=$S($D(^AUPNPRVT(DFN,0)):"YES",1:"NO")

 W !!

 W "Does this patient have PRIVATE INSURANCE COVERAGE? (Y/N) "

 W AG("DFLT"),"// "

 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 ^AGED7 K AGXTERN G:$G(NEWENTRY)=0 ^AG8 G L1

 ;I $G(^AGFAC(DUZ(2),"NEWADDINS")),$D(DUOUT) G DUOUT^AG6

 ;I $G(^AGFAC(DUZ(2),"NEWADDINS")),($G(AG("LT"))="NO") G ^AG8

 ;TESTING

 ;IHS/SD/TPF AG*7.1*1 9/22/2005

 ;I AG("LT")="YES" D ADDINS(DFN) G L1

 I AG("LT")="YES" D ADDINS(DFN) G ^AG8  ;AG*7.1*4 IM???? REPORTED BY THELMA

 ;END AG*7.1*1

 Q:$D(DTOUT)!$D(DFOUT)

 G DUOUT^AG6:$D(DUOUT)

 G L2:Y["Y",END1:Y["N"!($D(DLOUT)&(AG("DFLT")="NO")),L2:$D(DLOUT)&(AG("DFLT")="YES") D YN^AG G L1

ADDCOV ;EP - Add New Insurance.

L2 S AGELP("PDFN")=DFN

 S AGELP("TYPE")="PI"

 S:$D(AGCHRT) AGELP("HRN")=AGCHRT

 D INS^AGEL

L16 ;

END Q:$D(AG("EDIT"))

 I $G(AGADDINS)="A" K AG G ^AGED4A

 K AG

 G ^AG8

END1 G END:'$D(^AUPNPRVT(DFN,0))

DUOUT ;EP

 G L1:AGOPT(5)="Y",DUOUT^AG6

 Q

 ;NEW CODE AG*7.1*1 IHS/SD/TPF 9/22/2005

ADDINS(ID0) ;EP - ADD PRVT INS. USING NEW EDIT SCREENS

AGAIN ;EP

 K DIC,DIE,DA,DIR,DR,ADDCHK,AGNEWINS

 S DIC="^AUTNINS("

 S DIC(0)="AEMQZ"

 ;S DIC("S")="I $P($G(^(1)),U,7)'=0,($P($G(^(2)),U)=""P"")"

 S DIC("S")="I $P($G(^(1)),U,7)'=0,$$INSTYP^AGUTL(Y)=""P"""  ;IHS/OIT/NKD AG*7.1*12

 D ^DIC

 K DIC,DIE,DA,DIR,DR

 I +Y<1 W !!,"Must enter an existing private insurer" H 2 G AGAIN

 S INSPTR=+Y

 D EN^AGEDPRV(ID0,.ID1,1,"",INSPTR,.POLHPTR,.COVPTR)

 K NEWENTRY,AGSELECT

 Q:$G(Y)=AGOPT("ESCAPE")

 I '$O(^AUPNPRVT(ID0,11,0)) Q

 D:$G(INSPTR)'=""&('$D(AGKIDS))&($G(POLHPTR)'="")&($G(COVPTR)'="") EN^AGEDPRVB(ID0,ID1,1,"",$G(INSPTR),$G(POLHPTR),$G(COVPTR))

 Q

AG7       ; IHS/ASDS/EFG - ENTER PRIVATE INSURANCE DATA ;   

 +1       ;;7.1;PATIENT REGISTRATION;**1,2,3,12**;AUG 25, 2005;Build 1

 +2       ;

 +3       ;IHS/OIT/NKD AG*7.1*12 INSURER TYPE

 +4       ;

L1         KILL AGADD

 +1        IF AGOPT(5)'="Y"

               GOTO ^AG8

 +2        SET AG("DFLT")=$SELECT($DATA(^AUPNPRVT(DFN,0)):"YES",1:"NO")

 +3        WRITE !!

 +4        WRITE "Does this patient have PRIVATE INSURANCE COVERAGE? (Y/N) "

 +5        WRITE AG("DFLT"),"// "

 +6        DO READ^AG

 +7        SET AG("LT")=$SELECT($EXTRACT(Y)="Y":"YES",1:"NO")

 +8       ;TESTING USE OF EDIT SCREEN FOR ADDING INSURANCE TO NEW PATIENT 5/13/2005

 +9       ;I $G(^AGFAC(DUZ(2),"NEWADDINS")) I AG("LT")="YES" S AGPAT=$P($G(^DPT(DFN,0)),U) S AGXTERN=1 D ^AGED7 K AGXTERN G:$G(NEWENTRY)=0 ^AG8 G L1

 +10      ;I $G(^AGFAC(DUZ(2),"NEWADDINS")),$D(DUOUT) G DUOUT^AG6

 +11      ;I $G(^AGFAC(DUZ(2),"NEWADDINS")),($G(AG("LT"))="NO") G ^AG8

 +12      ;TESTING

 +13      ;IHS/SD/TPF AG*7.1*1 9/22/2005

 +14      ;I AG("LT")="YES" D ADDINS(DFN) G L1

 +15      ;AG*7.1*4 IM???? REPORTED BY THELMA

           IF AG("LT")="YES"

               DO ADDINS(DFN)

               GOTO ^AG8

 +16      ;END AG*7.1*1

 +17       IF $DATA(DTOUT)!$DATA(DFOUT)

               QUIT 

 +18       IF $DATA(DUOUT)

               GOTO DUOUT^AG6

 +19       IF Y["Y"

               GOTO L2

           IF Y["N"!($DATA(DLOUT)&(AG("DFLT")="NO"))

               GOTO END1

           IF $DATA(DLOUT)&(AG("DFLT")="YES")

               GOTO L2

           DO YN^AG

           GOTO L1

ADDCOV    ;EP - Add New Insurance.

L2         SET AGELP("PDFN")=DFN

 +1        SET AGELP("TYPE")="PI"

 +2        IF $DATA(AGCHRT)

               SET AGELP("HRN")=AGCHRT

 +3        DO INS^AGEL

L16       ;

END        IF $DATA(AG("EDIT"))

               QUIT 

 +1        IF $GET(AGADDINS)="A"

               KILL AG

               GOTO ^AGED4A

 +2        KILL AG

 +3        GOTO ^AG8

END1       IF '$DATA(^AUPNPRVT(DFN,0))

               GOTO END

DUOUT     ;EP

 +1        IF AGOPT(5)="Y"

               GOTO L1

           GOTO DUOUT^AG6

 +2        QUIT 

 +3       ;NEW CODE AG*7.1*1 IHS/SD/TPF 9/22/2005

ADDINS(ID0) ;EP - ADD PRVT INS. USING NEW EDIT SCREENS

AGAIN     ;EP

 +1        KILL DIC,DIE,DA,DIR,DR,ADDCHK,AGNEWINS

 +2        SET DIC="^AUTNINS("

 +3        SET DIC(0)="AEMQZ"

 +4       ;S DIC("S")="I $P($G(^(1)),U,7)'=0,($P($G(^(2)),U)=""P"")"

 +5       ;IHS/OIT/NKD AG*7.1*12

           SET DIC("S")="I $P($G(^(1)),U,7)'=0,$$INSTYP^AGUTL(Y)=""P"""

 +6        DO ^DIC

 +7        KILL DIC,DIE,DA,DIR,DR

 +8        IF +Y<1

               WRITE !!,"Must enter an existing private insurer"

               HANG 2

               GOTO AGAIN

 +9        SET INSPTR=+Y

 +10       DO EN^AGEDPRV(ID0,.ID1,1,"",INSPTR,.POLHPTR,.COVPTR)

 +11       KILL NEWENTRY,AGSELECT

 +12       IF $GET(Y)=AGOPT("ESCAPE")

               QUIT 

 +13       IF '$ORDER(^AUPNPRVT(ID0,11,0))

               QUIT 

 +14       IF $GET(INSPTR)'=""&('$DATA(AGKIDS))&($GET(POLHPTR)'="")&($GET(COVPTR)'="")

               DO EN^AGEDPRVB(ID0,ID1,1,"",$GET(INSPTR),$GET(POLHPTR),$GET(COVPTR))

 +15       QUIT