- 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
