Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ABPAPD8

ABPAPD8.m

Go to the documentation of this file.
ABPAPD8 ;CANCEL/DELETE PAYMENT ENTRY; [ 07/09/91  7:51 AM ]
 ;;1.4;AO PVT-INS TRACKING;*0*;IHS-OKC/KJR;JULY 25, 1991
A0 K DIR S DIR(0)="YO",DIR("B")="YES"
 S DIR("A")="DELETE THE CURRENT TRANSACTIONS - ARE YOUR SURE "
 S DIR("A")=DIR("A")_"(Y/N)" W *7 D ^DIR G DISP^ABPAPD3:'Y
A0A W !,"The current transactions for '",ABPAPAT,"' are being deleted "
A1 K DIC,DIE,DA,DR,DIK,ABPA("QF"),ABPADOS
 S ABPADOS=0 F ABPA("I")=0:0 D  Q:$D(ABPA("QF"))=1
 .S ABPADOS=$O(^ABPVAO(ABPATDFN,"P",ABPADDFN,"D",ABPADOS))
 .I +ABPADOS=0 S ABPA("QF")="" Q
 .S DA=$P(^ABPVAO(ABPATDFN,"P",ABPADDFN,"D",ABPADOS,0),"^",2)
 .Q:(+DA<1)!($D(^ABPVAO(ABPATDFN,1,DA,0))'=1)
 .K DIE,DR S DA(1)=ABPATDFN,DIE="^ABPVAO("_DA(1)_",1,",DR=".03///@"
 .D ^DIE S ZDA=0 F ABPAPCNT=0:1 D  I +ZDA=0 K ZDA Q
 ..S ZDA=$O(^ABPVAO("PD",ABPATDFN,DA,ZDA))
 .I +ABPAPCNT<2 D
 ..K DIE,DR S DA(1)=ABPATDFN,DIE="^ABPVAO("_DA(1)_",1,",DR=".18///O"
 ..D ^DIE W "."
A2 K DIC,DIE,DA,DR,DIK,ABPA("I"),ABPA("QF"),ABPAPCNT
 S DA(1)=ABPATDFN,DA=ABPADDFN,DIK="^ABPVAO("_DA(1)_",""P"","
 D ^DIK W "." H 1 L ^ABPVAO(ABPATDFN)
 G ^ABPAPD1