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

OOPS2P22.m

Go to the documentation of this file.
OOPS2P22 ;MNT/RRA FILE UPDATE TO 2263.6 ;04/24/08
 ;;2.0;ASISTS;**22**;Jun 03, 2002;Build 1
 ;
 Q
ADD ;
 N OOPSCODE,OOPSREG,OOPSNAME,OOPSCNT1,OOPSNEW,OOPSSTAT,OOPSVHO,OOPSDNM1,DINUM
 D MES^XPDUTL(" ")
 D BMES^XPDUTL("Adding new charge back code to ASISTS OWCP CHARGEBACK CODE FILE 2263.6(#725)...")
 D MES^XPDUTL(" ")
 S OOPSDNM1=$O(^OOPS(2263.6,9999),-1)
 F OOPSCNT1=1:1 S OOPSNEW=$P($T(NEW+OOPSCNT1),";;",2) Q:OOPSNEW="QUIT"  D
 .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)
 .S X=OOPSCODE D FILPROC
 D KILL1
 Q
NEW ;
 ;;CPAC Murfreesboro, TN^4104^731^9^CPAC
 ;;CPAC Asheville, NC^4109^730^6^CPAC
 ;;CPAC Madison, WI^4111^732^12^CPAC
 ;;Fort Sill National Cemetery^4459^920^3^NCS
 ;;QUIT
FILPROC ;
 I $D(^OOPS(2263.6,"B",OOPSCODE)) D
 .D MES^XPDUTL(" ")
 .D BMES^XPDUTL("   Your site has "_OOPSCODE_" in ASISTS OWCP CHARGEBACK CODE FILE 2263.6")
 I '$D(^OOPS(2263.6,"B",OOPSCODE)) D
 .S OOPSDNM1=OOPSDNM1+1,DINUM=OOPSDNM1,DIC(0)="L",DLAYGO=2263.6,DIC="^OOPS(2263.6,"
 .S DIC("DR")=".01////^S X=OOPSCODE;1///^S X=OOPSNAME;2///^S X=OOPSSTAT;3///^S X=OOPSREG;4///^S X=OOPSVHO"
 .D FILE^DICN
 .I +Y>0 D
 ..D MES^XPDUTL(" ")
 ..D BMES^XPDUTL(OOPSCODE_"  ...successfully added.")
 .I Y=-1 D 
 ..D MES^XPDUTL(" ")
 ..D BMES^XPDUTL("ERROR when attempting to add "_OOPSCODE)
 .K Y
 Q
KILL1 ;
 K DIC("DR"),DLAYGO,DIC,DIC(0),X