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 ---[H[J[2J[HOOPSXV25 559 printed Dec 13, 2024@01:40 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
