PXRMP65D ;ISP/AGP - PATCH 65 DIALOG CONVERSION ;May 03, 2022@09:30:27
;;2.0;CLINICAL REMINDERS;**65**;Feb 04, 2005;Build 438
Q
;
ACT(DIEN,ACTION) ;
N DATA,HASPRMPT,TYPE
S DATA=$$DETAIL^PXRMDRVI(DIEN)
S TYPE=$$EXTERNAL^DILFD(801.41,4,"",$P(DATA,U,2))
D MES^XPDUTL("Updating "_TYPE_" "_$P(DATA,U))
S HASPRMPT=$S(ACTION=3:1,1:$$HASPRMPT^PXRMDRVI(DIEN))
I HASPRMPT D PROMPT(DIEN)
I ACTION=1 D DISABLE(DIEN)
I ACTION=2 D FINDINGS(DIEN)
Q
;
DELDATA(DIEN,FIELD,NUM) ;
N DA,DIE,DR
S DIE="^PXRMD(801.41,"
I FIELD=15 S DA=DIEN,DR="15///@"
I FIELD=10 D
.S DA(1)=DIEN,DA=NUM
.S DIE=DIE_DA(1)_",10,",DR=".01///@"
I FIELD=18 D
.S DA(1)=DIEN,DA=NUM
.S DIE=DIE_DA(1)_",3,",DR=".01///@"
D ^DIE
Q
;
DISABLE(DA) ;
N DIE,DR
D MES^XPDUTL(" disabling item")
S DIE="^PXRMD(801.41,",DR="3////DISABLE AND DO NOT SEND MESSAGE"
D ^DIE
Q
;
DIALCONV ;
N ACTION,DARRAY,DIEN,GBL
D MES^XPDUTL("Building Dialogs to convert:")
F GBL="AUTTIMM(","AUTTSK(" D FINDDIAL^PXRMDRVI(GBL,.DARRAY)
D MES^XPDUTL("Converting Dialogs:")
S ACTION=0 F S ACTION=$O(DARRAY(ACTION)) Q:ACTION'>0 D
.S DIEN=0 F S DIEN=$O(DARRAY(ACTION,DIEN)) Q:DIEN'>0 D
..D ACT(DIEN,ACTION)
Q
;
FINDINGS(DIEN) ;
N FIND,NUM,TEMP
D MES^XPDUTL(" removing findings")
S FIND=$P($G(^PXRMD(801.41,DIEN,1)),U,5)
I FIND'["AUTTIMM",FIND'["AUTTSK",FIND'["PXD(811.2" D DELDATA(DIEN,15)
S FIND="" F S FIND=$O(^PXRMD(801.41,DIEN,3,"B",FIND)) Q:FIND="" D
.I FIND'["AUTTIMM",FIND'["AUTTSK",FIND'["PXD(811.2" D
..S NUM=$O(^PXRMD(801.41,DIEN,3,"B",FIND,""))
..S TEMP(NUM)=FIND
S NUM=0 F S NUM=$O(TEMP(NUM)) Q:NUM'>0 D
.D DELDATA(DIEN,18,NUM)
Q
;
PROMPT(DIEN) ;
N CIEN,DATA,ISIMMPMPT,IMMSER,NUM,TEMP
D MES^XPDUTL(" removing prompts")
S IMMSER=+$O(^PXRMD(801.42,"B","IMM_SER",""))
S CIEN=0 F S CIEN=$O(^PXRMD(801.41,DIEN,10,"D",CIEN)) Q:CIEN'>0 D
.S DATA=$$DETAIL^PXRMDRVI(CIEN) I "PF"[$P(DATA,U,2) D
..S ISIMMPMPT=0
..I $P(DATA,U,2)="F" D
...I IMMSER>0,+$P($G(^PXRMD(801.41,CIEN,46)),U),+$P($G(^PXRMD(801.41,CIEN,46)),U)=IMMSER S ISIMMPMPT=1
..I ISIMMPMPT=1 Q
..S NUM=$O(^PXRMD(801.41,DIEN,10,"D",CIEN,"")) S TEMP(NUM)=CIEN
S NUM=0 F S NUM=$O(TEMP(NUM)) Q:NUM'>0 D
.D DELDATA(DIEN,10,NUM)
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMP65D 2257 printed Apr 09, 2024@20:49:19 Page 2
PXRMP65D ;ISP/AGP - PATCH 65 DIALOG CONVERSION ;May 03, 2022@09:30:27
+1 ;;2.0;CLINICAL REMINDERS;**65**;Feb 04, 2005;Build 438
+2 QUIT
+3 ;
ACT(DIEN,ACTION) ;
+1 NEW DATA,HASPRMPT,TYPE
+2 SET DATA=$$DETAIL^PXRMDRVI(DIEN)
+3 SET TYPE=$$EXTERNAL^DILFD(801.41,4,"",$PIECE(DATA,U,2))
+4 DO MES^XPDUTL("Updating "_TYPE_" "_$PIECE(DATA,U))
+5 SET HASPRMPT=$SELECT(ACTION=3:1,1:$$HASPRMPT^PXRMDRVI(DIEN))
+6 IF HASPRMPT
DO PROMPT(DIEN)
+7 IF ACTION=1
DO DISABLE(DIEN)
+8 IF ACTION=2
DO FINDINGS(DIEN)
+9 QUIT
+10 ;
DELDATA(DIEN,FIELD,NUM) ;
+1 NEW DA,DIE,DR
+2 SET DIE="^PXRMD(801.41,"
+3 IF FIELD=15
SET DA=DIEN
SET DR="15///@"
+4 IF FIELD=10
Begin DoDot:1
+5 SET DA(1)=DIEN
SET DA=NUM
+6 SET DIE=DIE_DA(1)_",10,"
SET DR=".01///@"
End DoDot:1
+7 IF FIELD=18
Begin DoDot:1
+8 SET DA(1)=DIEN
SET DA=NUM
+9 SET DIE=DIE_DA(1)_",3,"
SET DR=".01///@"
End DoDot:1
+10 DO ^DIE
+11 QUIT
+12 ;
DISABLE(DA) ;
+1 NEW DIE,DR
+2 DO MES^XPDUTL(" disabling item")
+3 SET DIE="^PXRMD(801.41,"
SET DR="3////DISABLE AND DO NOT SEND MESSAGE"
+4 DO ^DIE
+5 QUIT
+6 ;
DIALCONV ;
+1 NEW ACTION,DARRAY,DIEN,GBL
+2 DO MES^XPDUTL("Building Dialogs to convert:")
+3 FOR GBL="AUTTIMM(","AUTTSK("
DO FINDDIAL^PXRMDRVI(GBL,.DARRAY)
+4 DO MES^XPDUTL("Converting Dialogs:")
+5 SET ACTION=0
FOR
SET ACTION=$ORDER(DARRAY(ACTION))
if ACTION'>0
QUIT
Begin DoDot:1
+6 SET DIEN=0
FOR
SET DIEN=$ORDER(DARRAY(ACTION,DIEN))
if DIEN'>0
QUIT
Begin DoDot:2
+7 DO ACT(DIEN,ACTION)
End DoDot:2
End DoDot:1
+8 QUIT
+9 ;
FINDINGS(DIEN) ;
+1 NEW FIND,NUM,TEMP
+2 DO MES^XPDUTL(" removing findings")
+3 SET FIND=$PIECE($GET(^PXRMD(801.41,DIEN,1)),U,5)
+4 IF FIND'["AUTTIMM"
IF FIND'["AUTTSK"
IF FIND'["PXD(811.2"
DO DELDATA(DIEN,15)
+5 SET FIND=""
FOR
SET FIND=$ORDER(^PXRMD(801.41,DIEN,3,"B",FIND))
if FIND=""
QUIT
Begin DoDot:1
+6 IF FIND'["AUTTIMM"
IF FIND'["AUTTSK"
IF FIND'["PXD(811.2"
Begin DoDot:2
+7 SET NUM=$ORDER(^PXRMD(801.41,DIEN,3,"B",FIND,""))
+8 SET TEMP(NUM)=FIND
End DoDot:2
End DoDot:1
+9 SET NUM=0
FOR
SET NUM=$ORDER(TEMP(NUM))
if NUM'>0
QUIT
Begin DoDot:1
+10 DO DELDATA(DIEN,18,NUM)
End DoDot:1
+11 QUIT
+12 ;
PROMPT(DIEN) ;
+1 NEW CIEN,DATA,ISIMMPMPT,IMMSER,NUM,TEMP
+2 DO MES^XPDUTL(" removing prompts")
+3 SET IMMSER=+$ORDER(^PXRMD(801.42,"B","IMM_SER",""))
+4 SET CIEN=0
FOR
SET CIEN=$ORDER(^PXRMD(801.41,DIEN,10,"D",CIEN))
if CIEN'>0
QUIT
Begin DoDot:1
+5 SET DATA=$$DETAIL^PXRMDRVI(CIEN)
IF "PF"[$PIECE(DATA,U,2)
Begin DoDot:2
+6 SET ISIMMPMPT=0
+7 IF $PIECE(DATA,U,2)="F"
Begin DoDot:3
+8 IF IMMSER>0
IF +$PIECE($GET(^PXRMD(801.41,CIEN,46)),U)
IF +$PIECE($GET(^PXRMD(801.41,CIEN,46)),U)=IMMSER
SET ISIMMPMPT=1
End DoDot:3
+9 IF ISIMMPMPT=1
QUIT
+10 SET NUM=$ORDER(^PXRMD(801.41,DIEN,10,"D",CIEN,""))
SET TEMP(NUM)=CIEN
End DoDot:2
End DoDot:1
+11 SET NUM=0
FOR
SET NUM=$ORDER(TEMP(NUM))
if NUM'>0
QUIT
Begin DoDot:1
+12 DO DELDATA(DIEN,10,NUM)
End DoDot:1
+13 QUIT
+14 ;
