DG531113 ;ALB/DTA - PRF CREATED BY SITE FIXES; OCT 24, 2023@01:19
;;5.3;Registration;**1113**;Aug 13, 1993;Build 10
;
;
Q
INIT ;Locate PRF's with unknown Created by site
N DGPAH,DGPRFD,DGPRFA,DGDAT,DGHIEN,DGFDA,DGPAT,DGCNT,DGDO,DGDTLT,DGERR,DGIEN,DGIENS,DGPDAT,DGPRFIEN
S DGCNT=0
S DGPRFIEN=0
S DGPRFA=0
D DGPATCH
W !,"Updating the Created by Site (.09) field for the PRF Assignment History (#26.14) file."
S DGPAH=0 F S DGPAH=+$O(^DGPF(26.14,DGPAH)) Q:'DGPAH D
. Q:'$D(^DGPF(26.14,DGPAH,0))
. I $P(^DGPF(26.14,DGPAH,0),"^",9)="" D
.. S DGPRFD=$P(^DGPF(26.14,DGPAH,0),"^",2) Q:DGPRFD<DGPDAT
.. S DGPRFA=$P(^DGPF(26.14,DGPAH,0),"^",1) D
... Q:DGPRFIEN=DGPRFA
... D LASTHIST
... S DGPRFIEN=DGPRFA
... Q
.. S DGCNT=DGCNT+1
.. D PRFASHST
.. D FILE^DIE("","DGFDA","DGERR")
.. I $D(DGERR) S DGIEN=0
.. Q
. Q
W !,DGCNT_" RECORDS UPDATED"
Q
DGPATCH ;Get date/time patch was installed
S DGDO=0
F S DGDO=$O(^XPD(9.7,DGDO)) Q:'DGDO D
. Q:'$D(^XPD(9.7,DGDO,0))
. S DGPAT=$P(^XPD(9.7,DGDO,0),"^",1) Q:DGPAT'="DG*5.3*1078"
. S DGPDAT=$P(^XPD(9.7,DGDO,1),"^",3)
. Q
Q
LASTHIST ;retrieve list of history IENs for an assignment
Q:DGPAH=$D(DGHIEN)
S DGHIEN=0
I $G(DGPRFA)>0,$D(^DGPF(26.13,DGPRFA)) D
. S DGDAT=$O(^DGPF(26.14,"C",DGPRFA,DGPRFD),-1)
. I DGDAT>0 D
. . S DGHIEN=$O(^DGPF(26.14,"C",DGPRFA,DGDAT,0))
Q $S($G(DGHIEN)>0:DGHIEN,1:0)
PRFASHST ;Does PRF Assignment = Last history record Originating site
N DGPRFHC,DGPRVH,DGOWNS,DGOCBS
S DGIENS=DGPAH_","
S DGOWNS=$P(^DGPF(26.13,DGPRFA,0),"^",4)
Q:DGHIEN'>0 S DGOCBS=$P(^DGPF(26.14,DGHIEN,0),"^",9)
Q:'$D(^DGPF(26.14,DGPAH,1,1,0))
S DGPRFHC=$P(^DGPF(26.14,DGPAH,1,1,0),"^")
I DGPRFHC["Change of flag assignment ownership"!("Ownership transfer request has been received for this flag.") D
. S DGDTLT=9999999
. F S DGDTLT=$O(^DGPF(26.14,"C",DGPRFA,DGDTLT),-1) Q:'DGDTLT D
.. S DGPRVH=0 S DGPRVH=$O(^DGPF(26.14,"C",DGPRFA,DGDTLT,DGPRVH))
.. I $P(^DGPF(26.14,DGPRVH,0),"^",3)=1 S DGOCBS=$P(^DGPF(26.14,DGPRVH,0),"^",9) Q
.. I $P($G(^DGPF(26.14,DGPRVH,0)),"^",9) S DGOCBS=$P(^DGPF(26.14,DGPRVH,0),"^",9)
.. Q
. Q
I DGOWNS=DGOCBS D
. S DGFDA(26.14,DGIENS,.09)=DGOWNS
. Q
E S DGFDA(26.14,DGIENS,.09)=DGOCBS
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDG531113 2272 printed Sep 23, 2025@20:11:46 Page 2
DG531113 ;ALB/DTA - PRF CREATED BY SITE FIXES; OCT 24, 2023@01:19
+1 ;;5.3;Registration;**1113**;Aug 13, 1993;Build 10
+2 ;
+3 ;
+4 QUIT
INIT ;Locate PRF's with unknown Created by site
+1 NEW DGPAH,DGPRFD,DGPRFA,DGDAT,DGHIEN,DGFDA,DGPAT,DGCNT,DGDO,DGDTLT,DGERR,DGIEN,DGIENS,DGPDAT,DGPRFIEN
+2 SET DGCNT=0
+3 SET DGPRFIEN=0
+4 SET DGPRFA=0
+5 DO DGPATCH
+6 WRITE !,"Updating the Created by Site (.09) field for the PRF Assignment History (#26.14) file."
+7 SET DGPAH=0
FOR
SET DGPAH=+$ORDER(^DGPF(26.14,DGPAH))
if 'DGPAH
QUIT
Begin DoDot:1
+8 if '$DATA(^DGPF(26.14,DGPAH,0))
QUIT
+9 IF $PIECE(^DGPF(26.14,DGPAH,0),"^",9)=""
Begin DoDot:2
+10 SET DGPRFD=$PIECE(^DGPF(26.14,DGPAH,0),"^",2)
if DGPRFD<DGPDAT
QUIT
+11 SET DGPRFA=$PIECE(^DGPF(26.14,DGPAH,0),"^",1)
Begin DoDot:3
+12 if DGPRFIEN=DGPRFA
QUIT
+13 DO LASTHIST
+14 SET DGPRFIEN=DGPRFA
+15 QUIT
End DoDot:3
+16 SET DGCNT=DGCNT+1
+17 DO PRFASHST
+18 DO FILE^DIE("","DGFDA","DGERR")
+19 IF $DATA(DGERR)
SET DGIEN=0
+20 QUIT
End DoDot:2
+21 QUIT
End DoDot:1
+22 WRITE !,DGCNT_" RECORDS UPDATED"
+23 QUIT
DGPATCH ;Get date/time patch was installed
+1 SET DGDO=0
+2 FOR
SET DGDO=$ORDER(^XPD(9.7,DGDO))
if 'DGDO
QUIT
Begin DoDot:1
+3 if '$DATA(^XPD(9.7,DGDO,0))
QUIT
+4 SET DGPAT=$PIECE(^XPD(9.7,DGDO,0),"^",1)
if DGPAT'="DG*5.3*1078"
QUIT
+5 SET DGPDAT=$PIECE(^XPD(9.7,DGDO,1),"^",3)
+6 QUIT
End DoDot:1
+7 QUIT
LASTHIST ;retrieve list of history IENs for an assignment
+1 if DGPAH=$DATA(DGHIEN)
QUIT
+2 SET DGHIEN=0
+3 IF $GET(DGPRFA)>0
IF $DATA(^DGPF(26.13,DGPRFA))
Begin DoDot:1
+4 SET DGDAT=$ORDER(^DGPF(26.14,"C",DGPRFA,DGPRFD),-1)
+5 IF DGDAT>0
Begin DoDot:2
+6 SET DGHIEN=$ORDER(^DGPF(26.14,"C",DGPRFA,DGDAT,0))
End DoDot:2
End DoDot:1
+7 QUIT $SELECT($GET(DGHIEN)>0:DGHIEN,1:0)
PRFASHST ;Does PRF Assignment = Last history record Originating site
+1 NEW DGPRFHC,DGPRVH,DGOWNS,DGOCBS
+2 SET DGIENS=DGPAH_","
+3 SET DGOWNS=$PIECE(^DGPF(26.13,DGPRFA,0),"^",4)
+4 if DGHIEN'>0
QUIT
SET DGOCBS=$PIECE(^DGPF(26.14,DGHIEN,0),"^",9)
+5 if '$DATA(^DGPF(26.14,DGPAH,1,1,0))
QUIT
+6 SET DGPRFHC=$PIECE(^DGPF(26.14,DGPAH,1,1,0),"^")
+7 IF DGPRFHC["Change of flag assignment ownership"!("Ownership transfer request has been received for this flag.")
Begin DoDot:1
+8 SET DGDTLT=9999999
+9 FOR
SET DGDTLT=$ORDER(^DGPF(26.14,"C",DGPRFA,DGDTLT),-1)
if 'DGDTLT
QUIT
Begin DoDot:2
+10 SET DGPRVH=0
SET DGPRVH=$ORDER(^DGPF(26.14,"C",DGPRFA,DGDTLT,DGPRVH))
+11 IF $PIECE(^DGPF(26.14,DGPRVH,0),"^",3)=1
SET DGOCBS=$PIECE(^DGPF(26.14,DGPRVH,0),"^",9)
QUIT
+12 IF $PIECE($GET(^DGPF(26.14,DGPRVH,0)),"^",9)
SET DGOCBS=$PIECE(^DGPF(26.14,DGPRVH,0),"^",9)
+13 QUIT
End DoDot:2
+14 QUIT
End DoDot:1
+15 IF DGOWNS=DGOCBS
Begin DoDot:1
+16 SET DGFDA(26.14,DGIENS,.09)=DGOWNS
+17 QUIT
End DoDot:1
+18 IF '$TEST
SET DGFDA(26.14,DGIENS,.09)=DGOCBS
+19 QUIT
