AGED4A2.m

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