OOPSXV25.m

OOPSXV25 ;WIOFO/LLH-POST INIT ROUTINE, FILL FIELD 331 ;07/12/04

 ;;2.0;ASISTS;**8**;Jun 03, 2002

 ; Patch 8 - auto populate file 2260, field 331

 ;

ENT ;

 N IEN,FILE,OWCP,OC6,SUF,STR

 S FILE=2260,IEN=0

 D BMES^XPDUTL("Updating new OWCP Code field") H 1

 D MES^XPDUTL(" ")

 F  S IEN=$O(^OOPS(FILE,IEN)) Q:IEN'>0  D

 .S STR=$G(^OOPS(FILE,IEN,"CA")),OWCP=$$GET1^DIQ(FILE,IEN,70)

 .S SUF=$P(STR,U,17),OC6=$P(STR,U,18)

 .I $G(OWCP)'="",$G(OC6)="" S $P(^OOPS(FILE,IEN,"CA"),U,18)=OWCP_SUF

 D BMES^XPDUTL("Update Complete") H 1

 D MES^XPDUTL(" ")

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---OOPSXV25   559     printed  Apr 09, 2024@20:43:49                                                                                                                                                                                                     Page 2

OOPSXV25  ;WIOFO/LLH-POST INIT ROUTINE, FILL FIELD 331 ;07/12/04

 +1       ;;2.0;ASISTS;**8**;Jun 03, 2002

 +2       ; Patch 8 - auto populate file 2260, field 331

 +3       ;

ENT       ;

 +1        NEW IEN,FILE,OWCP,OC6,SUF,STR

 +2        SET FILE=2260

           SET IEN=0

 +3        DO BMES^XPDUTL("Updating new OWCP Code field")

           HANG 1

 +4        DO MES^XPDUTL(" ")

 +5        FOR 

               SET IEN=$ORDER(^OOPS(FILE,IEN))

               if IEN'>0

                   QUIT 

               Begin DoDot:1

 +6                SET STR=$GET(^OOPS(FILE,IEN,"CA"))

                   SET OWCP=$$GET1^DIQ(FILE,IEN,70)

 +7                SET SUF=$PIECE(STR,U,17)

                   SET OC6=$PIECE(STR,U,18)

 +8                IF $GET(OWCP)'=""

                       IF $GET(OC6)=""

                           SET $PIECE(^OOPS(FILE,IEN,"CA"),U,18)=OWCP_SUF

               End DoDot:1

 +9        DO BMES^XPDUTL("Update Complete")

           HANG 1

 +10       DO MES^XPDUTL(" ")

 +11       QUIT