source: WorldVistAEHR/trunk/r/ASISTS-OOPS/OOPSTES4.m@ 1361

Last change on this file since 1361 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.1 KB
RevLine 
[613]1OOPSTES4 ;WIOFO/LLH FILE UPDATE TO 2263.6 ;04/24/08
2 ;;2.0;ASISTS;**16**;Jun 03, 2002;Build 4
3 ;
4ADD ;
5 N CODE,COUNT,CODX,NAME,ECX,ECXX,STAT,VHO,ECDINUM,DINUM
6 D MES^XPDUTL(" ")
7 D BMES^XPDUTL("Adding new charge back code to ASISTS OWCP CHARGEBACK CODE FILE 2263.6(#725)...")
8 D MES^XPDUTL(" ")
9 S ECDINUM=$O(^OOPS(2263.6,9999),-1),COUNT=$P(^OOPS(2263.6,0),U,4)
10 F ECX=1:1 S ECXX=$P($T(NEW+ECX),";;",2) Q:ECXX="QUIT" D
11 .S NAME=$P(ECXX,U,1),CODE=$P(ECXX,U,2),STAT=$P(ECXX,U,3),CODX=$P(ECXX,U,4),VHO=$P(ECXX,U,5)
12 .S X=CODE D FILPROC
13 D KILL1
14 Q
15NEW ;
16 ;;VAMC Orlando^4064^675^3^VHA
17 ;;QUIT
18FILPROC ;
19 I $D(^OOPS(2263.6,"B",CODE)) D
20 .D MES^XPDUTL(" ")
21 .D BMES^XPDUTL(" Your site has "_CODE_" in ASISTS OWCP CHARGEBACK CODE FILE 2263.6")
22 I '$D(^OOPS(2263.6,"B",CODE)) D
23 .S ECDINUM=ECDINUM+1,DINUM=ECDINUM,DIC(0)="L",DLAYGO=2263.6,DIC="^OOPS(2263.6,"
24 .S DIC("DR")=".01////^S X=CODE;1///^S X=NAME;2///^S X=STAT;3///^S X=CODX;4///^S X=VHO"
25 .D FILE^DICN
26 .I +Y>0 D
27 ..D MES^XPDUTL(" ")
28 ..D BMES^XPDUTL(CODE_" ...successfully added.")
29 .I Y=-1 D
30 ..D MES^XPDUTL(" ")
31 ..D BMES^XPDUTL("ERROR when attempting to add "_CODE)
32 .K Y
33 Q
34KILL1 ;
35 K DIC("DR"),DLAYGO,DIC,DIC(0),X
Note: See TracBrowser for help on using the repository browser.