- 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 Jan 18, 2025@03:36:41 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