TIUP336 ;SLC/TDP - Copy/Paste Clean-up of Division ;Jul 29, 2020@10:24:36
;;1.0;TEXT INTEGRATION UTILITIES;**336**;Jun 20, 1997;Build 4
;ICR
;10141-^XPDUTL ;10063-^%ZTLOAD ;10090-^DIC(4 ;10103-^XLFDT ;10015-^DIQ1
Q
PRE ;pre-init
Q
;
POST ;post-init
N ZTDTH,ZTIO,ZTSK,ZTRTN,ZTDESC
D BMES^XPDUTL("Tasking job to search for Copy/Paste data saved to the wrong Division...")
S ZTDTH=$$FMADD^XLFDT($$NOW^XLFDT,0,0,0,10)
S ZTRTN="SRCH^TIUP336",ZTDESC="TIU*1*336 Conversion of file #8928 institution pointers"
S ZTIO=""
D ^%ZTLOAD
I +$G(ZTSK)=0 D
. D BMES^XPDUTL("Unable to queue the file #8928 institution conversion job, file a help desk ticket for assistance.")
E D
. D BMES^XPDUTL("DONE - Task #"_ZTSK)
Q
;
CNVRT(TST) ;Convert Station Numbers stored as Institution IEN pointers
; If TST = 1, then print data for conversion but don't actually convert
; If TST = 2,
S TST=+$G(TST)
I TST=0 S TST=1
I TST<1,TST>2 D BMES^XPDUTL("Invalid parameter passed in. Must be a 1 or 2.")
D BMES^XPDUTL("Searching for Copy/Paste data saved to the wrong Division...")
D MES^XPDUTL("")
D SEARCH(TST)
D MES^XPDUTL("Search completed")
Q
;
SRCH ;Entry point for Post-Init
D SEARCH(0)
Q
SEARCH(TST) ;Search for Copy/Paste data stored with wrong division
N CNT,CNT1,DA,DIC,DIQ,DIV,DIV1,DR,RSLT,STN,STOP,TIUIEN,TMP
S CNT=0
S TST=+$G(TST)
I TST=1 D
. D MES^XPDUTL("This is a test run! Data Conversion will not occur!")
. D MES^XPDUTL("")
S (CNT1,DIV,STOP)=0
S DIC="^DIC(4," ;Institution file
S DR="99" ;Station Number
S DIQ="RSLT(" ;Array to return search
S DIQ(0)="I" ;Internal value returned
S TIUIEN=+$P($G(^TIUP(8928,0)),U,3)+1 ;Starting ien to search back to beginning
I TIUIEN<1 Q
F S TIUIEN=$O(^TIUP(8928,TIUIEN),-1) Q:+TIUIEN<1 D Q:STOP
. S CNT1=CNT1+1
. S DIV=$P($G(^TIUP(8928,TIUIEN,0)),U,3) ;Institution IEN stored in Paste data
. I +DIV<1 Q ;If not valid quit
. K RSLT
. S DA=DIV
. D EN^DIQ1 ;FileMan call to return Station Number for the Institution IEN (DA)
. S STN=$G(RSLT(4,DA,99,"I"))
. I STN="" Q ;Station Number does not exist
. I STN'=+STN Q ;Station Number is not all numerics
. I DIV=STN Q ;Station Number is same as ien in the Institution (#4) file
. S DIV1=$$FIND1^DIC(4,"","X",DIV,"D","","ERR") ;Search for Station Number that matches Institution IEN
. I +DIV1<1 Q ;Division IEN does not exist as a Station Number for another institution entry
. I TST'=1 S $P(^TIUP(8928,TIUIEN,0),U,3)=DIV1 ;Set new Institution ien into Paste data
. I CNT=0 S TMP=+TIUIEN
. I TST D
.. D MES^XPDUTL(" Changed ^TIUP(8928,"_TIUIEN_")")
.. D MES^XPDUTL(" Paste Date: "_$$FMTE^XLFDT($P($G(^TIUP(8928,TIUIEN,0)),U,1)))
.. D MES^XPDUTL(" Old Institution: "_$P($G(^DIC(4,DIV,0)),U,1)_" ("_DIV_")")
.. D MES^XPDUTL(" New Institution: "_$P($G(^DIC(4,DIV1,0)),U,1)_" ("_DIV1_")")
.. D MES^XPDUTL("")
. S CNT=CNT+1
. I '$D(TMP(DIV)) D
.. S TMP(DIV)=DIV1
. I '(CNT1#1000) S STOP=$$REQ2STOP()
I TST D
. D MES^XPDUTL(" Total Converted Count = "_CNT)
. D MES^XPDUTL("")
I $D(TMP(DIV)) D
. N %H,X,X1,X2
. ;S X1=DT
. ;S X2=30
. ;D C^%DTC
. S ^XTMP("TIUP336 - Post-Init",0)=$$FMADD^XLFDT(DT,30)_U_DT_U_CNT_" changed institution pointers in file #8928 - "_TMP
. S DIV=""
. F S DIV=$O(TMP(DIV)) Q:DIV="" D
.. S DIV1=$G(TMP(DIV))
.. S ^XTMP("TIUP336 - Post-Init",DIV)=DIV1
Q
;
REVERT ;Task off the Reversion process
N ZTDTH,ZTIO,ZTSK,ZTRTN,ZTDESC
S ZTDTH=$$FMADD^XLFDT($$NOW^XLFDT,0,0,0,10)
S ZTRTN="RVRTJB^TIUP336",ZTDESC="TIU*1*336 Reverting modified #8928 institution pointers"
S ZTIO=""
D ^%ZTLOAD
I +$G(ZTSK)=0 D
. W !!,"Unable to queue the file #8928 institution reversion job, file a help desk ticket for assistance."
E D
. W !!,"DONE - Task #"_ZTSK
Q
;
RVRTJB ;Reversion Tasked Job entry
D RVRTJOB(0)
Q
RVRTJOB(TST) ;Revert changed data back to original value
N CNT,CNT1,DIV,DIV1,PREVCNT,STOP,TIUIEN,TMP
D MES^XPDUTL("Reverting previously converted Institution file pointers in file #8928")
D MES^XPDUTL("")
S TST=+$G(TST)
I TST=1 D
. D MES^XPDUTL("This is a test run! Data Reversion will not occur!")
. D MES^XPDUTL("")
S (CNT,CNT1,STOP)=0
S TIUIEN=$P($G(^XTMP("TIUP336 - Post-Init",0)),"- ",2)+1 ;Starting ien to search back to beginning
S PREVCNT=+$P($G(^XTMP("TIUP336 - Post-Init",0)),U,3)
S DIV=0
F S DIV=$O(^XTMP("TIUP336 - Post-Init",DIV)) Q:DIV="" D
. S DIV1=+$G(^XTMP("TIUP336 - Post-Init",DIV))
. I +DIV1<1 Q
. S TMP(DIV1)=DIV
I '$D(TMP) Q
I TIUIEN<1 S TIUIEN=+$P($G(^TIUP(8928,0)),U,3)+1
F S TIUIEN=$O(^TIUP(8928,TIUIEN),-1) Q:+TIUIEN<1 D Q:STOP
. S DIV1=$P($G(^TIUP(8928,TIUIEN,0)),U,3) ;Institution IEN stored in Paste data
. I '$D(TMP(DIV1)) Q
. S DIV=$G(TMP(DIV1))
. I DIV<1 Q
. I TST'=1 S $P(^TIUP(8928,TIUIEN,0),U,3)=DIV
. S CNT=CNT+1
. I TST D
.. D MES^XPDUTL(" Reverted ^TIUP(8928,"_TIUIEN_")")
.. D MES^XPDUTL(" Paste Date: "_$$FMTE^XLFDT($P($G(^TIUP(8928,TIUIEN,0)),U,1)))
.. D MES^XPDUTL(" Old Institution: "_$P($G(^DIC(4,DIV1,0)),U,1)_" ("_DIV1_")")
.. D MES^XPDUTL(" New Institution: "_$P($G(^DIC(4,DIV,0)),U,1)_" ("_DIV_")")
.. D MES^XPDUTL("")
. I '(CNT1#1000) S STOP=$$REQ2STOP()
I CNT=0 D MES^XPDUTL(" No Institution file pointers were converted in file #8928")
I TST D
. D BMES^XPDUTL(" Total Converted Count = "_PREVCNT)
. D MES^XPDUTL(" Total Reverted Count = "_CNT)
I 'STOP,TST'=1 K ^XTMP("TIUP336 - Post-Init")
I 'STOP D BMES^XPDUTL("Reversion complete!")
I STOP D BMES^XPDUTL("Reversion stopped prematurely!")
Q
;
REQ2STOP() ;
; Check for task stop request
; Returns 1 if stop request made.
; If process was queued/tasked, then ZTQUEUED variable exists
N STATUS,X
S STATUS=0
I '$D(ZTQUEUED) Q 0
S X=$$S^%ZTLOAD()
I X D ;
. S STATUS=1
. S X=$$S^%ZTLOAD("Received shutdown request")
;
Q STATUS
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIUP336 5974 printed Sep 23, 2025@20:19:22 Page 2
TIUP336 ;SLC/TDP - Copy/Paste Clean-up of Division ;Jul 29, 2020@10:24:36
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**336**;Jun 20, 1997;Build 4
+2 ;ICR
+3 ;10141-^XPDUTL ;10063-^%ZTLOAD ;10090-^DIC(4 ;10103-^XLFDT ;10015-^DIQ1
+4 QUIT
PRE ;pre-init
+1 QUIT
+2 ;
POST ;post-init
+1 NEW ZTDTH,ZTIO,ZTSK,ZTRTN,ZTDESC
+2 DO BMES^XPDUTL("Tasking job to search for Copy/Paste data saved to the wrong Division...")
+3 SET ZTDTH=$$FMADD^XLFDT($$NOW^XLFDT,0,0,0,10)
+4 SET ZTRTN="SRCH^TIUP336"
SET ZTDESC="TIU*1*336 Conversion of file #8928 institution pointers"
+5 SET ZTIO=""
+6 DO ^%ZTLOAD
+7 IF +$GET(ZTSK)=0
Begin DoDot:1
+8 DO BMES^XPDUTL("Unable to queue the file #8928 institution conversion job, file a help desk ticket for assistance.")
End DoDot:1
+9 IF '$TEST
Begin DoDot:1
+10 DO BMES^XPDUTL("DONE - Task #"_ZTSK)
End DoDot:1
+11 QUIT
+12 ;
CNVRT(TST) ;Convert Station Numbers stored as Institution IEN pointers
+1 ; If TST = 1, then print data for conversion but don't actually convert
+2 ; If TST = 2,
+3 SET TST=+$GET(TST)
+4 IF TST=0
SET TST=1
+5 IF TST<1
IF TST>2
DO BMES^XPDUTL("Invalid parameter passed in. Must be a 1 or 2.")
+6 DO BMES^XPDUTL("Searching for Copy/Paste data saved to the wrong Division...")
+7 DO MES^XPDUTL("")
+8 DO SEARCH(TST)
+9 DO MES^XPDUTL("Search completed")
+10 QUIT
+11 ;
SRCH ;Entry point for Post-Init
+1 DO SEARCH(0)
+2 QUIT
SEARCH(TST) ;Search for Copy/Paste data stored with wrong division
+1 NEW CNT,CNT1,DA,DIC,DIQ,DIV,DIV1,DR,RSLT,STN,STOP,TIUIEN,TMP
+2 SET CNT=0
+3 SET TST=+$GET(TST)
+4 IF TST=1
Begin DoDot:1
+5 DO MES^XPDUTL("This is a test run! Data Conversion will not occur!")
+6 DO MES^XPDUTL("")
End DoDot:1
+7 SET (CNT1,DIV,STOP)=0
+8 ;Institution file
SET DIC="^DIC(4,"
+9 ;Station Number
SET DR="99"
+10 ;Array to return search
SET DIQ="RSLT("
+11 ;Internal value returned
SET DIQ(0)="I"
+12 ;Starting ien to search back to beginning
SET TIUIEN=+$PIECE($GET(^TIUP(8928,0)),U,3)+1
+13 IF TIUIEN<1
QUIT
+14 FOR
SET TIUIEN=$ORDER(^TIUP(8928,TIUIEN),-1)
if +TIUIEN<1
QUIT
Begin DoDot:1
+15 SET CNT1=CNT1+1
+16 ;Institution IEN stored in Paste data
SET DIV=$PIECE($GET(^TIUP(8928,TIUIEN,0)),U,3)
+17 ;If not valid quit
IF +DIV<1
QUIT
+18 KILL RSLT
+19 SET DA=DIV
+20 ;FileMan call to return Station Number for the Institution IEN (DA)
DO EN^DIQ1
+21 SET STN=$GET(RSLT(4,DA,99,"I"))
+22 ;Station Number does not exist
IF STN=""
QUIT
+23 ;Station Number is not all numerics
IF STN'=+STN
QUIT
+24 ;Station Number is same as ien in the Institution (#4) file
IF DIV=STN
QUIT
+25 ;Search for Station Number that matches Institution IEN
SET DIV1=$$FIND1^DIC(4,"","X",DIV,"D","","ERR")
+26 ;Division IEN does not exist as a Station Number for another institution entry
IF +DIV1<1
QUIT
+27 ;Set new Institution ien into Paste data
IF TST'=1
SET $PIECE(^TIUP(8928,TIUIEN,0),U,3)=DIV1
+28 IF CNT=0
SET TMP=+TIUIEN
+29 IF TST
Begin DoDot:2
+30 DO MES^XPDUTL(" Changed ^TIUP(8928,"_TIUIEN_")")
+31 DO MES^XPDUTL(" Paste Date: "_$$FMTE^XLFDT($PIECE($GET(^TIUP(8928,TIUIEN,0)),U,1)))
+32 DO MES^XPDUTL(" Old Institution: "_$PIECE($GET(^DIC(4,DIV,0)),U,1)_" ("_DIV_")")
+33 DO MES^XPDUTL(" New Institution: "_$PIECE($GET(^DIC(4,DIV1,0)),U,1)_" ("_DIV1_")")
+34 DO MES^XPDUTL("")
End DoDot:2
+35 SET CNT=CNT+1
+36 IF '$DATA(TMP(DIV))
Begin DoDot:2
+37 SET TMP(DIV)=DIV1
End DoDot:2
+38 IF '(CNT1#1000)
SET STOP=$$REQ2STOP()
End DoDot:1
if STOP
QUIT
+39 IF TST
Begin DoDot:1
+40 DO MES^XPDUTL(" Total Converted Count = "_CNT)
+41 DO MES^XPDUTL("")
End DoDot:1
+42 IF $DATA(TMP(DIV))
Begin DoDot:1
+43 NEW %H,X,X1,X2
+44 ;S X1=DT
+45 ;S X2=30
+46 ;D C^%DTC
+47 SET ^XTMP("TIUP336 - Post-Init",0)=$$FMADD^XLFDT(DT,30)_U_DT_U_CNT_" changed institution pointers in file #8928 - "_TMP
+48 SET DIV=""
+49 FOR
SET DIV=$ORDER(TMP(DIV))
if DIV=""
QUIT
Begin DoDot:2
+50 SET DIV1=$GET(TMP(DIV))
+51 SET ^XTMP("TIUP336 - Post-Init",DIV)=DIV1
End DoDot:2
End DoDot:1
+52 QUIT
+53 ;
REVERT ;Task off the Reversion process
+1 NEW ZTDTH,ZTIO,ZTSK,ZTRTN,ZTDESC
+2 SET ZTDTH=$$FMADD^XLFDT($$NOW^XLFDT,0,0,0,10)
+3 SET ZTRTN="RVRTJB^TIUP336"
SET ZTDESC="TIU*1*336 Reverting modified #8928 institution pointers"
+4 SET ZTIO=""
+5 DO ^%ZTLOAD
+6 IF +$GET(ZTSK)=0
Begin DoDot:1
+7 WRITE !!,"Unable to queue the file #8928 institution reversion job, file a help desk ticket for assistance."
End DoDot:1
+8 IF '$TEST
Begin DoDot:1
+9 WRITE !!,"DONE - Task #"_ZTSK
End DoDot:1
+10 QUIT
+11 ;
RVRTJB ;Reversion Tasked Job entry
+1 DO RVRTJOB(0)
+2 QUIT
RVRTJOB(TST) ;Revert changed data back to original value
+1 NEW CNT,CNT1,DIV,DIV1,PREVCNT,STOP,TIUIEN,TMP
+2 DO MES^XPDUTL("Reverting previously converted Institution file pointers in file #8928")
+3 DO MES^XPDUTL("")
+4 SET TST=+$GET(TST)
+5 IF TST=1
Begin DoDot:1
+6 DO MES^XPDUTL("This is a test run! Data Reversion will not occur!")
+7 DO MES^XPDUTL("")
End DoDot:1
+8 SET (CNT,CNT1,STOP)=0
+9 ;Starting ien to search back to beginning
SET TIUIEN=$PIECE($GET(^XTMP("TIUP336 - Post-Init",0)),"- ",2)+1
+10 SET PREVCNT=+$PIECE($GET(^XTMP("TIUP336 - Post-Init",0)),U,3)
+11 SET DIV=0
+12 FOR
SET DIV=$ORDER(^XTMP("TIUP336 - Post-Init",DIV))
if DIV=""
QUIT
Begin DoDot:1
+13 SET DIV1=+$GET(^XTMP("TIUP336 - Post-Init",DIV))
+14 IF +DIV1<1
QUIT
+15 SET TMP(DIV1)=DIV
End DoDot:1
+16 IF '$DATA(TMP)
QUIT
+17 IF TIUIEN<1
SET TIUIEN=+$PIECE($GET(^TIUP(8928,0)),U,3)+1
+18 FOR
SET TIUIEN=$ORDER(^TIUP(8928,TIUIEN),-1)
if +TIUIEN<1
QUIT
Begin DoDot:1
+19 ;Institution IEN stored in Paste data
SET DIV1=$PIECE($GET(^TIUP(8928,TIUIEN,0)),U,3)
+20 IF '$DATA(TMP(DIV1))
QUIT
+21 SET DIV=$GET(TMP(DIV1))
+22 IF DIV<1
QUIT
+23 IF TST'=1
SET $PIECE(^TIUP(8928,TIUIEN,0),U,3)=DIV
+24 SET CNT=CNT+1
+25 IF TST
Begin DoDot:2
+26 DO MES^XPDUTL(" Reverted ^TIUP(8928,"_TIUIEN_")")
+27 DO MES^XPDUTL(" Paste Date: "_$$FMTE^XLFDT($PIECE($GET(^TIUP(8928,TIUIEN,0)),U,1)))
+28 DO MES^XPDUTL(" Old Institution: "_$PIECE($GET(^DIC(4,DIV1,0)),U,1)_" ("_DIV1_")")
+29 DO MES^XPDUTL(" New Institution: "_$PIECE($GET(^DIC(4,DIV,0)),U,1)_" ("_DIV_")")
+30 DO MES^XPDUTL("")
End DoDot:2
+31 IF '(CNT1#1000)
SET STOP=$$REQ2STOP()
End DoDot:1
if STOP
QUIT
+32 IF CNT=0
DO MES^XPDUTL(" No Institution file pointers were converted in file #8928")
+33 IF TST
Begin DoDot:1
+34 DO BMES^XPDUTL(" Total Converted Count = "_PREVCNT)
+35 DO MES^XPDUTL(" Total Reverted Count = "_CNT)
End DoDot:1
+36 IF 'STOP
IF TST'=1
KILL ^XTMP("TIUP336 - Post-Init")
+37 IF 'STOP
DO BMES^XPDUTL("Reversion complete!")
+38 IF STOP
DO BMES^XPDUTL("Reversion stopped prematurely!")
+39 QUIT
+40 ;
REQ2STOP() ;
+1 ; Check for task stop request
+2 ; Returns 1 if stop request made.
+3 ; If process was queued/tasked, then ZTQUEUED variable exists
+4 NEW STATUS,X
+5 SET STATUS=0
+6 IF '$DATA(ZTQUEUED)
QUIT 0
+7 SET X=$$S^%ZTLOAD()
+8 ;
IF X
Begin DoDot:1
+9 SET STATUS=1
+10 SET X=$$S^%ZTLOAD("Received shutdown request")
End DoDot:1
+11 ;
+12 QUIT STATUS
