OOPSTES4.m

OOPSTES4 ;WIOFO/LLH FILE UPDATE TO 2263.6 ;04/24/08

 ;;2.0;ASISTS;**16**;Jun 03, 2002;Build 4

 ;

ADD ;

 N CODE,COUNT,CODX,NAME,ECX,ECXX,STAT,VHO,ECDINUM,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 ECDINUM=$O(^OOPS(2263.6,9999),-1),COUNT=$P(^OOPS(2263.6,0),U,4)

 F ECX=1:1 S ECXX=$P($T(NEW+ECX),";;",2) Q:ECXX="QUIT"  D

 .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)

 .S X=CODE D FILPROC

 D KILL1

 Q

NEW ;

 ;;VAMC Orlando^4064^675^3^VHA

 ;;QUIT

FILPROC ;

 I $D(^OOPS(2263.6,"B",CODE)) D

 .D MES^XPDUTL(" ")

 .D BMES^XPDUTL("   Your site has "_CODE_" in ASISTS OWCP CHARGEBACK CODE FILE 2263.6")

 I '$D(^OOPS(2263.6,"B",CODE)) D

 .S ECDINUM=ECDINUM+1,DINUM=ECDINUM,DIC(0)="L",DLAYGO=2263.6,DIC="^OOPS(2263.6,"

 .S DIC("DR")=".01////^S X=CODE;1///^S X=NAME;2///^S X=STAT;3///^S X=CODX;4///^S X=VHO"

 .D FILE^DICN

 .I +Y>0 D

 ..D MES^XPDUTL(" ")

 ..D BMES^XPDUTL(CODE_"  ...successfully added.")

 .I Y=-1 D 

 ..D MES^XPDUTL(" ")

 ..D BMES^XPDUTL("ERROR when attempting to add "_CODE)

 .K Y

 Q

KILL1 ;

 K DIC("DR"),DLAYGO,DIC,DIC(0),X

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---OOPSTES4   1212     printed  Apr 09, 2024@20:44:36                                                                                                                                                                                                    Page 2

OOPSTES4  ;WIOFO/LLH FILE UPDATE TO 2263.6 ;04/24/08

 +1       ;;2.0;ASISTS;**16**;Jun 03, 2002;Build 4

 +2       ;

ADD       ;

 +1        NEW CODE,COUNT,CODX,NAME,ECX,ECXX,STAT,VHO,ECDINUM,DINUM

 +2        DO MES^XPDUTL(" ")

 +3        DO BMES^XPDUTL("Adding new charge back code to ASISTS OWCP CHARGEBACK CODE FILE 2263.6(#725)...")

 +4        DO MES^XPDUTL(" ")

 +5        SET ECDINUM=$ORDER(^OOPS(2263.6,9999),-1)

           SET COUNT=$PIECE(^OOPS(2263.6,0),U,4)

 +6        FOR ECX=1:1

               SET ECXX=$PIECE($TEXT(NEW+ECX),";;",2)

               if ECXX="QUIT"

                   QUIT 

               Begin DoDot:1

 +7                SET NAME=$PIECE(ECXX,U,1)

                   SET CODE=$PIECE(ECXX,U,2)

                   SET STAT=$PIECE(ECXX,U,3)

                   SET CODX=$PIECE(ECXX,U,4)

                   SET VHO=$PIECE(ECXX,U,5)

 +8                SET X=CODE

                   DO FILPROC

               End DoDot:1

 +9        DO KILL1

 +10       QUIT 

NEW       ;

 +1       ;;VAMC Orlando^4064^675^3^VHA

 +2       ;;QUIT

FILPROC   ;

 +1        IF $DATA(^OOPS(2263.6,"B",CODE))

               Begin DoDot:1

 +2                DO MES^XPDUTL(" ")

 +3                DO BMES^XPDUTL("   Your site has "_CODE_" in ASISTS OWCP CHARGEBACK CODE FILE 2263.6")

               End DoDot:1

 +4        IF '$DATA(^OOPS(2263.6,"B",CODE))

               Begin DoDot:1

 +5                SET ECDINUM=ECDINUM+1

                   SET DINUM=ECDINUM

                   SET DIC(0)="L"

                   SET DLAYGO=2263.6

                   SET DIC="^OOPS(2263.6,"

 +6                SET DIC("DR")=".01////^S X=CODE;1///^S X=NAME;2///^S X=STAT;3///^S X=CODX;4///^S X=VHO"

 +7                DO FILE^DICN

 +8                IF +Y>0

                       Begin DoDot:2

 +9                        DO MES^XPDUTL(" ")

 +10                       DO BMES^XPDUTL(CODE_"  ...successfully added.")

                       End DoDot:2

 +11               IF Y=-1

                       Begin DoDot:2

 +12                       DO MES^XPDUTL(" ")

 +13                       DO BMES^XPDUTL("ERROR when attempting to add "_CODE)

                       End DoDot:2

 +14               KILL Y

               End DoDot:1

 +15       QUIT 

KILL1     ;

 +1        KILL DIC("DR"),DLAYGO,DIC,DIC(0),X