ABPACDF2.m

ABPACDF2 ;PVT-INSDELETE OPEN CLAIMS;[ 05/24/91  1:13 PM ]

 ;;1.4;AO PVT-INS TRACKING;*0*;IHS-OKC/KJR;JULY 25, 1991

DTHD D ^%AUCLS S X=ABPATLE_" - DELETE CLAIMS for a patient"

 W ?(40-($L(X)/2)),X,!,ABPAX,!

 W @ABPARON,ABPAPAT_"  ("_ABPAHRN_") "_$E(ABPAL,1,25),@ABPAROFF

 W !,"Other Names Used:"

 S ZR=0 F I=0:0 D  Q:+ZR=0

 .S ZR=$O(^ABPVAO(ABPATDFN,"AKA",ZR)) Q:+ZR=0

 .W:$X>20 ! W ?20,$P(^ABPVAO(ABPATDFN,"AKA",ZR,0),"^")," ("

 .W:$P(^ABPVAO(ABPATDFN,"AKA",ZR,0),"^",2)=1 "Alias)"

 .W:$P(^ABPVAO(ABPATDFN,"AKA",ZR,0),"^",2)'=1 "Look-up only)"

 W !,ABPAX

 W !?8,"Insurance",?23,"Date of",?34,".....Claim.....",?53,"......."

 W "..Payment........",!,?8,"Company",?23,"Service",?34,"Amount",?43

 W "Status",?53,"Date(s)",?65,"Amount  Type",!,ABPAXX

 Q

ABPACDF2  ;PVT-INSDELETE OPEN CLAIMS;[ 05/24/91  1:13 PM ]

 +1       ;;1.4;AO PVT-INS TRACKING;*0*;IHS-OKC/KJR;JULY 25, 1991

DTHD       DO ^%AUCLS

           SET X=ABPATLE_" - DELETE CLAIMS for a patient"

 +1        WRITE ?(40-($LENGTH(X)/2)),X,!,ABPAX,!

 +2        WRITE @ABPARON,ABPAPAT_"  ("_ABPAHRN_") "_$EXTRACT(ABPAL,1,25),@ABPAROFF

 +3        WRITE !,"Other Names Used:"

 +4        SET ZR=0

           FOR I=0:0

               Begin DoDot:1

 +5                SET ZR=$ORDER(^ABPVAO(ABPATDFN,"AKA",ZR))

                   IF +ZR=0

                       QUIT 

 +6                IF $X>20

                       WRITE !

                   WRITE ?20,$PIECE(^ABPVAO(ABPATDFN,"AKA",ZR,0),"^")," ("

 +7                IF $PIECE(^ABPVAO(ABPATDFN,"AKA",ZR,0),"^",2)=1

                       WRITE "Alias)"

 +8                IF $PIECE(^ABPVAO(ABPATDFN,"AKA",ZR,0),"^",2)'=1

                       WRITE "Look-up only)"

               End DoDot:1

               IF +ZR=0

                   QUIT 

 +9        WRITE !,ABPAX

 +10       WRITE !?8,"Insurance",?23,"Date of",?34,".....Claim.....",?53,"......."

 +11       WRITE "..Payment........",!,?8,"Company",?23,"Service",?34,"Amount",?43

 +12       WRITE "Status",?53,"Date(s)",?65,"Amount  Type",!,ABPAXX

 +13       QUIT