- 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 Feb 18, 2025@23:14:26 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 ;