PXRMP45D ;ISP/AGP - PATCH 45 DIALOG CONVERSION ;10/16/2019
;;2.0;CLINICAL REMINDERS;**45**;Feb 04, 2005;Build 566
Q
;
DELETE(ARRAY) ;
N FIELD,FDA,IEN,MSG
S IEN=0 F S IEN=$O(^XTMP(PXRMXTMP,IEN)) Q:IEN'>0 D
.K FDA
.S IENS=IEN_","
.F FIELD=116,117,118 S FDA(801.41,IENS,FIELD)="@"
.I $D(FDA) D FILE^DIE("","FDA","MSG")
.I $D(MSG) D AWRITE^PXRMUTIL("MSG")
.K ^PXRMD(801.41,IEN,49)
Q
;
GTDIALOG ;
N DARRAY,IEN,NAME,NODE,TEXT
S IEN=0 F S IEN=$O(^PXRMD(801.41,IEN)) Q:IEN'>0 D
.S NAME=$P($G(^PXRMD(801.41,IEN,0)),U)
.S NODE=$G(^PXRMD(801.41,IEN,49))
.I $P(NODE,U)'>0 Q
.S DARRAY(IEN)=""
.I $P(NODE,U,2)>1!($P(NODE,U,2)<0)!($L($P(NODE,U,2))>1) D Q
..S TEXT(1)="Branching Logic node for dialog definition: "_NAME
..S TEXT(2)="is not defined correctly. This dialog definition will not be converted."
..S TEXT(3)="Node is defined as: "_NODE
..D MES^XPDUTL(.TEXT)
.S ^XTMP(PXRMXTMP,IEN)=NODE
.S ^XTMP(PXRMXTMP,IEN,"DONE")=0
D DELETE(.DARRAY)
Q
;
PRE ;
D MES^XPDUTL(" Copying Reminder dialogs with branching logic to a ^XTMP global...")
N PXRMXTMP,PXRMSKIP,PXRMGTMP
S PXRMXTMP="PXRM DIALOG CONVERSION"
K ^XTMP(PXRMXTMP)
S ^XTMP(PXRMXTMP,0)=$$FMADD^XLFDT(DT,30)_U_DT_U_"PXRM Patch 45 Dialog Conversion"
D GTDIALOG
D MES^XPDUTL(" DONE")
Q
;
POST ;
N PXRMXTMP
S PXRMXTMP="PXRM DIALOG CONVERSION"
D STDIALOG
Q
;
REBUILD ;
N DA,I,DIK
D BMES^XPDUTL(" Reindexing component multiple in file #801.41...")
;S DIK="^PXRMD(801.41,"
S I=0 F S I=$O(^PXRMD(801.41,I)) Q:I'>0 D
.S DA(1)=I,DIK="^PXRMD(801.41,"_DA(1)_",10,"
.S DA=0 F S DA=$O(^PXRMD(801.41,I,10,DA)) Q:DA'>0 D
..D IX^DIK
D MES^XPDUTL(" DONE")
Q
;
RESCIND ;
N DA,DIE,DISABLE,DR,PXRMINST
S PXRMINST=1
S DA=$O(^PXD(811.9,"B","VA-WH MAMMOGRAM REVIEW RESULTS",""))
I DA>0 D
.S DISABLE=1
.D MES^XPDUTL("Rescinding Reminder Defintion VA-WH MAMMOGRAM REVIEW RESULTS")
.D RENAME^PXRMUTIL(811.9,"VA-WH MAMMOGRAM REVIEW RESULTS","ZZ VA-WH MAMMOGRAM REVIEW RESULTS")
.S DIE="^PXD(811.9,",DR="1.6///^S X=DISABLE;69///^S X=DT"
.D ^DIE
;
K DA
S DA=$O(^PXRMD(801.41,"B","VA-WH MAMMOGRAM REVIEW RESULTS",""))
I DA>0 D
.S DISABLE=2
.D MES^XPDUTL("Rescinding Reminder Dialog VA-WH MAMMOGRAM REVIEW RESULTS")
.D RENAME^PXRMUTIL(801.41,"VA-WH MAMMOGRAM REVIEW RESULTS","ZZ VA-WH MAMMOGRAM REVIEW RESULTS")
.S DIE="^PXRMD(801.41,",DR="3///^S X=DISABLE"
.D ^DIE
Q
STDIALOG ;
N IEN,NODE
D BMES^XPDUTL(" Updating Reminder Dialogs...")
S IEN=0 F S IEN=$O(^XTMP(PXRMXTMP,IEN)) Q:IEN'>0 D
.S NODE=$G(^XTMP(PXRMXTMP,IEN))
.D UPDATE(IEN,NODE)
D MES^XPDUTL(" DONE")
Q
;
UPDATE(DIEN,NODE) ;
N ACTION,EVALSTAT,FDA,IENS,MSG,NAME,RNAME,TEXT,TNAME
S RNAME="",ACTION="H"
S NAME=$P(^PXRMD(801.41,DIEN,0),U)
S TNAME=$P($G(^PXRMD(811.5,$P(NODE,U),0)),U)
S EVALSTAT=$S($P(NODE,U,2)=1:"T",1:"F")
I $P(NODE,U,3)>0 S RNAME=$P($G(^PXRMD(801.41,$P(NODE,U,3),0)),U),ACTION="R"
I TNAME="" D Q
.S TEXT(1)="Dialog Definition: "_NAME_"does not"
.S TEXT(2)="have a valid Reminder Term assigned. This dialog definition will not be converted."
.S TEXT(3)="Node is defined as: "_NODE
.D MES^XPDUTL(.TEXT)
S IENS="?+2,"_DIEN_","
S FDA(801.41143,IENS,.01)=1
S FDA(801.41143,IENS,1)="TM."_TNAME
S FDA(801.41143,IENS,2)=EVALSTAT
S FDA(801.41143,IENS,3)=ACTION
I RNAME'="" S FDA(801.41143,IENS,4)=RNAME
D MES^XPDUTL(" Updating dialog: "_NAME)
D UPDATE^DIE("E","FDA","","MSG")
I '$D(MSG) S ^XTMP(PXRMXTMP,DIEN,"DONE")=1
I $D(MSG) D AWRITE^PXRMUTIL("MSG")
Q
;
CLEANUP ;
N IEN,NODE
S PXRMXTMP="PXRM DIALOG CONVERSION"
S IEN=0 F S IEN=$O(^XTMP(PXRMXTMP,IEN)) Q:IEN'>0 D
.;D CLEAND(IEN)
.K ^PXRMD(801.41,IEN,"BL")
Q
;
CLEAND(IEN) ;
S NODE=$G(^XTMP(PXRMXTMP,IEN))
I $P(NODE,U,3)>0 W !,"Skipping IEN: "_IEN Q
I $G(^PXRMD(801.41,IEN,"BL",1,0))="" Q
S $P(^PXRMD(801.41,IEN,"BL",1,0),U,4)="H"
W !,"Upated IEN: "_IEN_" "_^PXRMD(801.41,IEN,"BL",1,0)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMP45D 3984 printed Jun 11, 2024@21:35:17 Page 2
PXRMP45D ;ISP/AGP - PATCH 45 DIALOG CONVERSION ;10/16/2019
+1 ;;2.0;CLINICAL REMINDERS;**45**;Feb 04, 2005;Build 566
+2 QUIT
+3 ;
DELETE(ARRAY) ;
+1 NEW FIELD,FDA,IEN,MSG
+2 SET IEN=0
FOR
SET IEN=$ORDER(^XTMP(PXRMXTMP,IEN))
if IEN'>0
QUIT
Begin DoDot:1
+3 KILL FDA
+4 SET IENS=IEN_","
+5 FOR FIELD=116,117,118
SET FDA(801.41,IENS,FIELD)="@"
+6 IF $DATA(FDA)
DO FILE^DIE("","FDA","MSG")
+7 IF $DATA(MSG)
DO AWRITE^PXRMUTIL("MSG")
+8 KILL ^PXRMD(801.41,IEN,49)
End DoDot:1
+9 QUIT
+10 ;
GTDIALOG ;
+1 NEW DARRAY,IEN,NAME,NODE,TEXT
+2 SET IEN=0
FOR
SET IEN=$ORDER(^PXRMD(801.41,IEN))
if IEN'>0
QUIT
Begin DoDot:1
+3 SET NAME=$PIECE($GET(^PXRMD(801.41,IEN,0)),U)
+4 SET NODE=$GET(^PXRMD(801.41,IEN,49))
+5 IF $PIECE(NODE,U)'>0
QUIT
+6 SET DARRAY(IEN)=""
+7 IF $PIECE(NODE,U,2)>1!($PIECE(NODE,U,2)<0)!($LENGTH($PIECE(NODE,U,2))>1)
Begin DoDot:2
+8 SET TEXT(1)="Branching Logic node for dialog definition: "_NAME
+9 SET TEXT(2)="is not defined correctly. This dialog definition will not be converted."
+10 SET TEXT(3)="Node is defined as: "_NODE
+11 DO MES^XPDUTL(.TEXT)
End DoDot:2
QUIT
+12 SET ^XTMP(PXRMXTMP,IEN)=NODE
+13 SET ^XTMP(PXRMXTMP,IEN,"DONE")=0
End DoDot:1
+14 DO DELETE(.DARRAY)
+15 QUIT
+16 ;
PRE ;
+1 DO MES^XPDUTL(" Copying Reminder dialogs with branching logic to a ^XTMP global...")
+2 NEW PXRMXTMP,PXRMSKIP,PXRMGTMP
+3 SET PXRMXTMP="PXRM DIALOG CONVERSION"
+4 KILL ^XTMP(PXRMXTMP)
+5 SET ^XTMP(PXRMXTMP,0)=$$FMADD^XLFDT(DT,30)_U_DT_U_"PXRM Patch 45 Dialog Conversion"
+6 DO GTDIALOG
+7 DO MES^XPDUTL(" DONE")
+8 QUIT
+9 ;
POST ;
+1 NEW PXRMXTMP
+2 SET PXRMXTMP="PXRM DIALOG CONVERSION"
+3 DO STDIALOG
+4 QUIT
+5 ;
REBUILD ;
+1 NEW DA,I,DIK
+2 DO BMES^XPDUTL(" Reindexing component multiple in file #801.41...")
+3 ;S DIK="^PXRMD(801.41,"
+4 SET I=0
FOR
SET I=$ORDER(^PXRMD(801.41,I))
if I'>0
QUIT
Begin DoDot:1
+5 SET DA(1)=I
SET DIK="^PXRMD(801.41,"_DA(1)_",10,"
+6 SET DA=0
FOR
SET DA=$ORDER(^PXRMD(801.41,I,10,DA))
if DA'>0
QUIT
Begin DoDot:2
+7 DO IX^DIK
End DoDot:2
End DoDot:1
+8 DO MES^XPDUTL(" DONE")
+9 QUIT
+10 ;
RESCIND ;
+1 NEW DA,DIE,DISABLE,DR,PXRMINST
+2 SET PXRMINST=1
+3 SET DA=$ORDER(^PXD(811.9,"B","VA-WH MAMMOGRAM REVIEW RESULTS",""))
+4 IF DA>0
Begin DoDot:1
+5 SET DISABLE=1
+6 DO MES^XPDUTL("Rescinding Reminder Defintion VA-WH MAMMOGRAM REVIEW RESULTS")
+7 DO RENAME^PXRMUTIL(811.9,"VA-WH MAMMOGRAM REVIEW RESULTS","ZZ VA-WH MAMMOGRAM REVIEW RESULTS")
+8 SET DIE="^PXD(811.9,"
SET DR="1.6///^S X=DISABLE;69///^S X=DT"
+9 DO ^DIE
End DoDot:1
+10 ;
+11 KILL DA
+12 SET DA=$ORDER(^PXRMD(801.41,"B","VA-WH MAMMOGRAM REVIEW RESULTS",""))
+13 IF DA>0
Begin DoDot:1
+14 SET DISABLE=2
+15 DO MES^XPDUTL("Rescinding Reminder Dialog VA-WH MAMMOGRAM REVIEW RESULTS")
+16 DO RENAME^PXRMUTIL(801.41,"VA-WH MAMMOGRAM REVIEW RESULTS","ZZ VA-WH MAMMOGRAM REVIEW RESULTS")
+17 SET DIE="^PXRMD(801.41,"
SET DR="3///^S X=DISABLE"
+18 DO ^DIE
End DoDot:1
+19 QUIT
STDIALOG ;
+1 NEW IEN,NODE
+2 DO BMES^XPDUTL(" Updating Reminder Dialogs...")
+3 SET IEN=0
FOR
SET IEN=$ORDER(^XTMP(PXRMXTMP,IEN))
if IEN'>0
QUIT
Begin DoDot:1
+4 SET NODE=$GET(^XTMP(PXRMXTMP,IEN))
+5 DO UPDATE(IEN,NODE)
End DoDot:1
+6 DO MES^XPDUTL(" DONE")
+7 QUIT
+8 ;
UPDATE(DIEN,NODE) ;
+1 NEW ACTION,EVALSTAT,FDA,IENS,MSG,NAME,RNAME,TEXT,TNAME
+2 SET RNAME=""
SET ACTION="H"
+3 SET NAME=$PIECE(^PXRMD(801.41,DIEN,0),U)
+4 SET TNAME=$PIECE($GET(^PXRMD(811.5,$PIECE(NODE,U),0)),U)
+5 SET EVALSTAT=$SELECT($PIECE(NODE,U,2)=1:"T",1:"F")
+6 IF $PIECE(NODE,U,3)>0
SET RNAME=$PIECE($GET(^PXRMD(801.41,$PIECE(NODE,U,3),0)),U)
SET ACTION="R"
+7 IF TNAME=""
Begin DoDot:1
+8 SET TEXT(1)="Dialog Definition: "_NAME_"does not"
+9 SET TEXT(2)="have a valid Reminder Term assigned. This dialog definition will not be converted."
+10 SET TEXT(3)="Node is defined as: "_NODE
+11 DO MES^XPDUTL(.TEXT)
End DoDot:1
QUIT
+12 SET IENS="?+2,"_DIEN_","
+13 SET FDA(801.41143,IENS,.01)=1
+14 SET FDA(801.41143,IENS,1)="TM."_TNAME
+15 SET FDA(801.41143,IENS,2)=EVALSTAT
+16 SET FDA(801.41143,IENS,3)=ACTION
+17 IF RNAME'=""
SET FDA(801.41143,IENS,4)=RNAME
+18 DO MES^XPDUTL(" Updating dialog: "_NAME)
+19 DO UPDATE^DIE("E","FDA","","MSG")
+20 IF '$DATA(MSG)
SET ^XTMP(PXRMXTMP,DIEN,"DONE")=1
+21 IF $DATA(MSG)
DO AWRITE^PXRMUTIL("MSG")
+22 QUIT
+23 ;
CLEANUP ;
+1 NEW IEN,NODE
+2 SET PXRMXTMP="PXRM DIALOG CONVERSION"
+3 SET IEN=0
FOR
SET IEN=$ORDER(^XTMP(PXRMXTMP,IEN))
if IEN'>0
QUIT
Begin DoDot:1
+4 ;D CLEAND(IEN)
+5 KILL ^PXRMD(801.41,IEN,"BL")
End DoDot:1
+6 QUIT
+7 ;
CLEAND(IEN) ;
+1 SET NODE=$GET(^XTMP(PXRMXTMP,IEN))
+2 IF $PIECE(NODE,U,3)>0
WRITE !,"Skipping IEN: "_IEN
QUIT
+3 IF $GET(^PXRMD(801.41,IEN,"BL",1,0))=""
QUIT
+4 SET $PIECE(^PXRMD(801.41,IEN,"BL",1,0),U,4)="H"
+5 WRITE !,"Upated IEN: "_IEN_" "_^PXRMD(801.41,IEN,"BL",1,0)
+6 QUIT
