AGED4A2 ; IHS/ASDS/EFG - PAGE 4 - INSURANCE SUMMARY PART 3;
;;7.1;PATIENT REGISTRATION;**2**;JAN 31, 2007
;
;AG*7.1*2 AG/SD/TPF 6/26/2006 PAGE 37 OF TASK ORDER
VPROMPT(AGPTR) ;EP - VIEW SEQUENCES FOR PARTICULAR CATEGORY
N CATDT,CATREC,IENS,SUBITEM
K VIEWDT
AGAIN ;
I '$D(^AUPNICP("EFF",AGPATDFN,AGPTR)) W !!,"PATIENT HAS NO SEQUENCING TO VIEW IN THIS CATEGORY!" H 3 Q
W !!,"PRIOR SEQUENCING DATES:"
K CATENTRY
S CATDT=""
F ITEM=1:1 S CATDT=$O(^AUPNICP("EFF",AGPATDFN,AGPTR,CATDT),-1) Q:CATDT="" D
.S Y=CATDT X ^DD("DD")
.W !!,ITEM_". "
.W " "_Y
.W !?20,"INSURER",?38,"COVERAGE",?50,"PRIORITY"
.W !?20,"=======",?38,"========",?50,"========"
.S CATREC=""
.F SUBITEM=1:1 S CATREC=$O(^AUPNICP("EFF",AGPATDFN,AGPTR,CATDT,CATREC)) Q:CATREC="" D
..S CATENTRY(ITEM,CATREC)=CATDT
..W !?12," "
..S IENS=$P($G(^AUPNICP(CATREC,0)),U,3)
..I IENS'["(" W $E($$GET1^DIQ(9000035,CATREC_",",.03,"E","AGDATA","AGERR"),1,20)
..E I IENS'="",(IENS'["AUPNPAT") W $P($G(@(U_$P($G(^AUPNICP(CATREC,0)),U,3))),U)
..E I IENS'="",(IENS["AUPNPAT") D
...S IENS=$P($P(IENS,","),"(",2)
...W $P($G(^DPT(IENS,0)),U)
..W ?38,$$GET1^DIQ(9000035,CATREC_",",.07,,"AGDATA","AGERR")
..W ?50,$$GET1^DIQ(9000035,CATREC_",",.05,,"AGDATA","AGERR")
S ITEM=ITEM-1
ASKITEM ;EP - ASK SEQUENCE ENTRY ITEM TO DELETE OR VIEW
N VIEWDT,DELDT
W !
K DIR,DUOUT,DTOUT
S DIR(0)="NO^1:"_ITEM
D ^DIR
Q:Y=""
Q:$D(DUOUT)!($D(DTOUT))
S CATENTRY=Y
S VIEWDT=$O(CATENTRY(CATENTRY,""))
S:VIEWDT'="" VIEWDT=CATENTRY(CATENTRY,VIEWDT)
K DIR,DUOUT,DTOUT
S DIR(0)="SO^V:VIEW;R:REVERSE"
D ^DIR
G:$D(DUOUT) ASKITEM
G:Y=""!(Y[U)!($D(DTOUT)) ASKITEM
I Y="V" S OLDPTR=CATPTR,AGANS="V" S CATPTR=AGPTR D DISPCAT^AGED4A1 Q:AGANS'="V" G AGAIN
I Y="R" D Q:'Y
.K DIR
.W !!,"You have selected:"
.S (Y,DELDT)=VIEWDT X ^DD("DD") S VIEWDT=Y
.W !!,?4,"SEQ DATE: ",VIEWDT
.W !!,"Are you sure you want to reverse?"
.W !!
.S DIR(0)="Y"
.D ^DIR
D REVERSE(.CATENTRY) ;THE TERM 'REVERSE' DOESN'T MAKE SENSE TO ME
; DO THEY MEAN REVERT OR DELETE?
;DELETE THE AGCAT ENTRY TOO
K AGCAT(CATPTR,DELDT)
Q
REVERSE(CATENTRY) ;EP - DELETE CATEGORY PRIORITIZING ENTRY
N ENTRY
S ENTRY=CATENTRY
K DA,DIK
S DIK="^AUPNICP("
S DA=""
F S DA=$O(CATENTRY(ENTRY,DA)) Q:'DA D
.D ^DIK
Q
AGED4A2 ; IHS/ASDS/EFG - PAGE 4 - INSURANCE SUMMARY PART 3;
+1 ;;7.1;PATIENT REGISTRATION;**2**;JAN 31, 2007
+2 ;
+3 ;AG*7.1*2 AG/SD/TPF 6/26/2006 PAGE 37 OF TASK ORDER
VPROMPT(AGPTR) ;EP - VIEW SEQUENCES FOR PARTICULAR CATEGORY
+1 NEW CATDT,CATREC,IENS,SUBITEM
+2 KILL VIEWDT
AGAIN ;
+1 IF '$DATA(^AUPNICP("EFF",AGPATDFN,AGPTR))
WRITE !!,"PATIENT HAS NO SEQUENCING TO VIEW IN THIS CATEGORY!"
HANG 3
QUIT
+2 WRITE !!,"PRIOR SEQUENCING DATES:"
+3 KILL CATENTRY
+4 SET CATDT=""
+5 FOR ITEM=1:1
SET CATDT=$ORDER(^AUPNICP("EFF",AGPATDFN,AGPTR,CATDT),-1)
IF CATDT=""
QUIT
Begin DoDot:1
+6 SET Y=CATDT
XECUTE ^DD("DD")
+7 WRITE !!,ITEM_". "
+8 WRITE " "_Y
+9 WRITE !?20,"INSURER",?38,"COVERAGE",?50,"PRIORITY"
+10 WRITE !?20,"=======",?38,"========",?50,"========"
+11 SET CATREC=""
+12 FOR SUBITEM=1:1
SET CATREC=$ORDER(^AUPNICP("EFF",AGPATDFN,AGPTR,CATDT,CATREC))
IF CATREC=""
QUIT
Begin DoDot:2
+13 SET CATENTRY(ITEM,CATREC)=CATDT
+14 WRITE !?12," "
+15 SET IENS=$PIECE($GET(^AUPNICP(CATREC,0)),U,3)
+16 IF IENS'["("
WRITE $EXTRACT($$GET1^DIQ(9000035,CATREC_",",.03,"E","AGDATA","AGERR"),1,20)
+17 IF '$TEST
IF IENS'=""
IF (IENS'["AUPNPAT")
WRITE $PIECE($GET(@(U_$PIECE($GET(^AUPNICP(CATREC,0)),U,3))),U)
+18 IF '$TEST
IF IENS'=""
IF (IENS["AUPNPAT")
Begin DoDot:3
+19 SET IENS=$PIECE($PIECE(IENS,","),"(",2)
+20 WRITE $PIECE($GET(^DPT(IENS,0)),U)
End DoDot:3
+21 WRITE ?38,$$GET1^DIQ(9000035,CATREC_",",.07,,"AGDATA","AGERR")
+22 WRITE ?50,$$GET1^DIQ(9000035,CATREC_",",.05,,"AGDATA","AGERR")
End DoDot:2
End DoDot:1
+23 SET ITEM=ITEM-1
ASKITEM ;EP - ASK SEQUENCE ENTRY ITEM TO DELETE OR VIEW
+1 NEW VIEWDT,DELDT
+2 WRITE !
+3 KILL DIR,DUOUT,DTOUT
+4 SET DIR(0)="NO^1:"_ITEM
+5 DO ^DIR
+6 IF Y=""
QUIT
+7 IF $DATA(DUOUT)!($DATA(DTOUT))
QUIT
+8 SET CATENTRY=Y
+9 SET VIEWDT=$ORDER(CATENTRY(CATENTRY,""))
+10 IF VIEWDT'=""
SET VIEWDT=CATENTRY(CATENTRY,VIEWDT)
+11 KILL DIR,DUOUT,DTOUT
+12 SET DIR(0)="SO^V:VIEW;R:REVERSE"
+13 DO ^DIR
+14 IF $DATA(DUOUT)
GOTO ASKITEM
+15 IF Y=""!(Y[U)!($DATA(DTOUT))
GOTO ASKITEM
+16 IF Y="V"
SET OLDPTR=CATPTR
SET AGANS="V"
SET CATPTR=AGPTR
DO DISPCAT^AGED4A1
IF AGANS'="V"
QUIT
GOTO AGAIN
+17 IF Y="R"
Begin DoDot:1
+18 KILL DIR
+19 WRITE !!,"You have selected:"
+20 SET (Y,DELDT)=VIEWDT
XECUTE ^DD("DD")
SET VIEWDT=Y
+21 WRITE !!,?4,"SEQ DATE: ",VIEWDT
+22 WRITE !!,"Are you sure you want to reverse?"
+23 WRITE !!
+24 SET DIR(0)="Y"
+25 DO ^DIR
End DoDot:1
IF 'Y
QUIT
+26 ;THE TERM 'REVERSE' DOESN'T MAKE SENSE TO ME
DO REVERSE(.CATENTRY)
+27 ; DO THEY MEAN REVERT OR DELETE?
+28 ;DELETE THE AGCAT ENTRY TOO
+29 KILL AGCAT(CATPTR,DELDT)
+30 QUIT
REVERSE(CATENTRY) ;EP - DELETE CATEGORY PRIORITIZING ENTRY
+1 NEW ENTRY
+2 SET ENTRY=CATENTRY
+3 KILL DA,DIK
+4 SET DIK="^AUPNICP("
+5 SET DA=""
+6 FOR
SET DA=$ORDER(CATENTRY(ENTRY,DA))
IF 'DA
QUIT
Begin DoDot:1
+7 DO ^DIK
End DoDot:1
+8 QUIT
