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

OOPS2P26.m

Go to the documentation of this file.
  1. OOPS2P26 ;MNT/RRA FILE UPDATE TO 2263.6 ;04/24/08
  1. ;;2.0;ASISTS;**26**;Jun 03, 2002;Build 4
  1. ;
  1. Q
  1. ADD ;
  1. N OOPSCODE,OOPSREG,OOPSNAME,OOPSCNT1,OOPSNEW,OOPSSTAT,OOPSVHO,OOPSDNM1,DINUM
  1. D MES^XPDUTL(" ")
  1. D BMES^XPDUTL("Adding new CHARGEBACK code to ASISTS OWCP CHARGEBACK CODE FILE (#2263.6)...")
  1. D MES^XPDUTL(" ")
  1. S OOPSDNM1=$O(^OOPS(2263.6,9999),-1)
  1. F OOPSCNT1=1:1 S OOPSNEW=$P($T(NEW+OOPSCNT1),";;",2) Q:OOPSNEW="QUIT" D
  1. .S OOPSNAME=$P(OOPSNEW,U,1),OOPSCODE=$P(OOPSNEW,U,2),OOPSSTAT=$P(OOPSNEW,U,3),OOPSREG=$P(OOPSNEW,U,4),OOPSVHO=$P(OOPSNEW,U,5)
  1. .S X=OOPSCODE D FILPROC
  1. D KILL1
  1. Q
  1. NEW ;
  1. ;;Texas Valley Coastal Bend^4303^740^17^VHA
  1. ;;QUIT
  1. FILPROC ;
  1. I $D(^OOPS(2263.6,"B",OOPSCODE)) D
  1. .D MES^XPDUTL(" ")
  1. .D BMES^XPDUTL(" Your site has "_OOPSCODE_" in ASISTS OWCP CHARGEBACK CODE FILE 2263.6")
  1. I '$D(^OOPS(2263.6,"B",OOPSCODE)) D
  1. .S OOPSDNM1=OOPSDNM1+1,DINUM=OOPSDNM1,DIC(0)="L",DLAYGO=2263.6,DIC="^OOPS(2263.6,"
  1. .S DIC("DR")=".01////^S X=OOPSCODE;1///^S X=OOPSNAME;2///^S X=OOPSSTAT;3///^S X=OOPSREG;4///^S X=OOPSVHO"
  1. .D FILE^DICN
  1. .I +Y>0 D
  1. ..D MES^XPDUTL(" ")
  1. ..D BMES^XPDUTL(OOPSCODE_" ...successfully added.")
  1. .I Y=-1 D
  1. ..D MES^XPDUTL(" ")
  1. ..D BMES^XPDUTL("ERROR when attempting to add "_OOPSCODE)
  1. .K Y
  1. Q
  1. KILL1 ;
  1. K DIC("DR"),DLAYGO,DIC,DIC(0),X
  1. Q