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