PXRMDUTL ; SLC/AGP - DIALOG UTILITIES. ;04/10/2013
;;2.0;CLINICAL REMINDERS;**24,26**;Feb 04, 2005;Build 404
Q
;
;==========================================
ALLOWDEL(IEN) ; check to see if the item can be deleted
N CLASS,TYPE
S TYPE=$P($G(^PXRMD(801.41,IEN,0)),U,4)
S CLASS=$P($G(^PXRMD(801.41,IEN,100)),U)
I (CLASS="N")&((TYPE="P")!(TYPE="F")) Q 0
Q 1
;
DELD(DIEN) ; delete the dialog item
N ARRAY,CNT,DARRAY,DA,DIK,PXRMINST
S CNT=0
D DITEMAR(DIEN,.ARRAY,.DARRAY,.CNT)
S PXRMINST=1
S DIK="^PXRMD(801.41,"
S CNT="" F S CNT=$O(ARRAY(CNT),-1) Q:CNT="" D
.S DA=$O(ARRAY(CNT,"")) Q:DA'>0
.I $$ALLOWDEL(DA)=0 Q
.D ^DIK
Q
;
; builds an array of items beneath the dialog item, lowest item first.
DITEMAR(DIEN,ARRAY,DARRAY,DCNT) ;
; DIEN is the IEN of the dialog top level
; Array contains the dialog elements and groups within the dialog.
N CNT,IEN,REPIEN,TYPE
S CNT=0 F S CNT=$O(^PXRMD(801.41,DIEN,10,CNT)) Q:CNT'>0 D
.S IEN=$P($G(^PXRMD(801.41,DIEN,10,CNT,0)),U,2) Q:IEN'>0
.S REPIEN=$P($G(^PXRMD(801.41,IEN,49)),U,3)
.I REPIEN>0 D DITEMAR(REPIEN,.ARRAY,.DARRAY,.DCNT)
.S TYPE=$P($G(^PXRMD(801.41,IEN,0)),U,4)
.I TYPE="G"!(TYPE="E") D DITEMAR(IEN,.ARRAY,.DARRAY,.DCNT)
.I '$D(DARRAY(IEN)) S DARRAY(IEN)="",DCNT=DCNT+1,ARRAY(DCNT,IEN)=""
I '$D(DARRAY(DIEN)) S DARRAY(DIEN)="",DCNT=DCNT+1,ARRAY(DCNT,DIEN)=""
Q
;
DMAKENAT(DA) ; sets the class field and renamed to the correct national format
N CLASS,DIE,DR,IEN,NAME,NEWNAME,PREFIX,TYPE
S NAME=$P($G(^PXRMD(801.41,DA,0)),U)
I $E(NAME,1,3)="VA-"!($E(NAME,1,4)="PXRM") Q
S CLASS="N"
S DIE="^PXRMXD(801.41,"
S DR="100////^S X=CLASS"
D ^DIE
S TYPE=$P($G(^PXRMD(801.41,DA,0)),U,4)
S PREFIX=$S(TYPE="R":"VA-",TYPE="G":"VA-",TYPE="E":"VA-",1:"PXRM ")
S NEWNAME=PREFIX_NAME
D RENAME^PXRMUTIL(801.41,NAME,NEWNAME)
Q
;
;=============================================================
; Build an array of findings for dialog types
; Input a string of characters for the dialog type field.
; example "EGS" = search element, groups, result groups
; Output an array by finding types, Finding IEN, Dialog IEN, "F" or "A"
; example OUT("AUTTHF(",608,631,"F")=""
FARRAY(OUTPUT,TYPES) ;
N AFIEN,AFIND,DIEN,FIND,NODE,OI,TYPE,X
F X=1:1:$L(TYPES) S TYPE=$E(TYPES,X) D
.S DIEN=""
.F S DIEN=$O(^PXRMD(801.41,"TYPE",TYPE,DIEN)) Q:DIEN'>0 D
..I TYPE="S" D Q
...S FIND=$P($G(^PXRMD(801.41,DIEN,50)),U)
...I FIND'="" D SETGBL(.OUTPUT,DIEN,FIND_";YTT(601.71,","RG",0)
..S NODE=$G(^PXRMD(801.41,DIEN,1))
..S FIND=$P(NODE,U,5),OI=$P(NODE,U,7)
..I FIND'="" D SETGBL(.OUTPUT,DIEN,FIND,"F",0)
..I OI'="" D SETGBL(.OUTPUT,DIEN,OI_";ORD(101.43,","O",0)
..S AFIND=""
..F S AFIND=$O(^PXRMD(801.41,DIEN,3,"B",AFIND)) Q:AFIND="" D
...S AFIEN=$O(^PXRMD(801.41,DIEN,3,"B",AFIND,""))
...D SETGBL(.OUTPUT,DIEN,AFIND,"A",AFIEN)
Q
;
RTAXNAME(NAME) ;
I '$D(^PXD(811.2,"B",NAME)) Q NAME
N CNT,FOUND,RESULT,TEMP
S TEMP=NAME,CNT=0
I $L(NAME)>64 S TEMP=$E(NAME,1,60)
S TEMP=TEMP_"*"
I '$D(^PXD(811.2,"B",TEMP)) Q TEMP
S FOUND=0
F D Q:FOUND=1
.S CNT=CNT+1
.I '$D(^PXD(811.2,"B",TEMP_CNT)) S RESULT=TEMP_CNT,FOUND=1
Q RESULT
;
SETGBL(ARRAY,DIEN,VARP,LOC,IEN) ;
N FIEN,GBL
S GBL=$P(VARP,";",2),FIEN=$P(VARP,";")
I LOC="A" S ARRAY(GBL,FIEN,DIEN,LOC,IEN)="" Q
S ARRAY(GBL,FIEN,DIEN,LOC)=""
Q
;
NATCONV(DIEN) ; entry point to convert a local dialog to a national dialog
N ARRAY,IEN
D DITEMAR(DIEN,.ARRAY)
S IEN=0 F S IEN=$O(ARRAY(IEN)) Q:IEN'>0 D
.D DMAKENAT(IEN)
D DMAKENAT(DIEN)
Q
;
PXRMDUTL ; SLC/AGP - DIALOG UTILITIES. ;04/10/2013
+1 ;;2.0;CLINICAL REMINDERS;**24,26**;Feb 04, 2005;Build 404
+2 QUIT
+3 ;
+4 ;==========================================
ALLOWDEL(IEN) ; check to see if the item can be deleted
+1 NEW CLASS,TYPE
+2 SET TYPE=$PIECE($GET(^PXRMD(801.41,IEN,0)),U,4)
+3 SET CLASS=$PIECE($GET(^PXRMD(801.41,IEN,100)),U)
+4 IF (CLASS="N")&((TYPE="P")!(TYPE="F"))
QUIT 0
+5 QUIT 1
+6 ;
DELD(DIEN) ; delete the dialog item
+1 NEW ARRAY,CNT,DARRAY,DA,DIK,PXRMINST
+2 SET CNT=0
+3 DO DITEMAR(DIEN,.ARRAY,.DARRAY,.CNT)
+4 SET PXRMINST=1
+5 SET DIK="^PXRMD(801.41,"
+6 SET CNT=""
FOR
SET CNT=$ORDER(ARRAY(CNT),-1)
IF CNT=""
QUIT
Begin DoDot:1
+7 SET DA=$ORDER(ARRAY(CNT,""))
IF DA'>0
QUIT
+8 IF $$ALLOWDEL(DA)=0
QUIT
+9 DO ^DIK
End DoDot:1
+10 QUIT
+11 ;
+12 ; builds an array of items beneath the dialog item, lowest item first.
DITEMAR(DIEN,ARRAY,DARRAY,DCNT) ;
+1 ; DIEN is the IEN of the dialog top level
+2 ; Array contains the dialog elements and groups within the dialog.
+3 NEW CNT,IEN,REPIEN,TYPE
+4 SET CNT=0
FOR
SET CNT=$ORDER(^PXRMD(801.41,DIEN,10,CNT))
IF CNT'>0
QUIT
Begin DoDot:1
+5 SET IEN=$PIECE($GET(^PXRMD(801.41,DIEN,10,CNT,0)),U,2)
IF IEN'>0
QUIT
+6 SET REPIEN=$PIECE($GET(^PXRMD(801.41,IEN,49)),U,3)
+7 IF REPIEN>0
DO DITEMAR(REPIEN,.ARRAY,.DARRAY,.DCNT)
+8 SET TYPE=$PIECE($GET(^PXRMD(801.41,IEN,0)),U,4)
+9 IF TYPE="G"!(TYPE="E")
DO DITEMAR(IEN,.ARRAY,.DARRAY,.DCNT)
+10 IF '$DATA(DARRAY(IEN))
SET DARRAY(IEN)=""
SET DCNT=DCNT+1
SET ARRAY(DCNT,IEN)=""
End DoDot:1
+11 IF '$DATA(DARRAY(DIEN))
SET DARRAY(DIEN)=""
SET DCNT=DCNT+1
SET ARRAY(DCNT,DIEN)=""
+12 QUIT
+13 ;
DMAKENAT(DA) ; sets the class field and renamed to the correct national format
+1 NEW CLASS,DIE,DR,IEN,NAME,NEWNAME,PREFIX,TYPE
+2 SET NAME=$PIECE($GET(^PXRMD(801.41,DA,0)),U)
+3 IF $EXTRACT(NAME,1,3)="VA-"!($EXTRACT(NAME,1,4)="PXRM")
QUIT
+4 SET CLASS="N"
+5 SET DIE="^PXRMXD(801.41,"
+6 SET DR="100////^S X=CLASS"
+7 DO ^DIE
+8 SET TYPE=$PIECE($GET(^PXRMD(801.41,DA,0)),U,4)
+9 SET PREFIX=$SELECT(TYPE="R":"VA-",TYPE="G":"VA-",TYPE="E":"VA-",1:"PXRM ")
+10 SET NEWNAME=PREFIX_NAME
+11 DO RENAME^PXRMUTIL(801.41,NAME,NEWNAME)
+12 QUIT
+13 ;
+14 ;=============================================================
+15 ; Build an array of findings for dialog types
+16 ; Input a string of characters for the dialog type field.
+17 ; example "EGS" = search element, groups, result groups
+18 ; Output an array by finding types, Finding IEN, Dialog IEN, "F" or "A"
+19 ; example OUT("AUTTHF(",608,631,"F")=""
FARRAY(OUTPUT,TYPES) ;
+1 NEW AFIEN,AFIND,DIEN,FIND,NODE,OI,TYPE,X
+2 FOR X=1:1:$LENGTH(TYPES)
SET TYPE=$EXTRACT(TYPES,X)
Begin DoDot:1
+3 SET DIEN=""
+4 FOR
SET DIEN=$ORDER(^PXRMD(801.41,"TYPE",TYPE,DIEN))
IF DIEN'>0
QUIT
Begin DoDot:2
+5 IF TYPE="S"
Begin DoDot:3
+6 SET FIND=$PIECE($GET(^PXRMD(801.41,DIEN,50)),U)
+7 IF FIND'=""
DO SETGBL(.OUTPUT,DIEN,FIND_";YTT(601.71,","RG",0)
End DoDot:3
QUIT
+8 SET NODE=$GET(^PXRMD(801.41,DIEN,1))
+9 SET FIND=$PIECE(NODE,U,5)
SET OI=$PIECE(NODE,U,7)
+10 IF FIND'=""
DO SETGBL(.OUTPUT,DIEN,FIND,"F",0)
+11 IF OI'=""
DO SETGBL(.OUTPUT,DIEN,OI_";ORD(101.43,","O",0)
+12 SET AFIND=""
+13 FOR
SET AFIND=$ORDER(^PXRMD(801.41,DIEN,3,"B",AFIND))
IF AFIND=""
QUIT
Begin DoDot:3
+14 SET AFIEN=$ORDER(^PXRMD(801.41,DIEN,3,"B",AFIND,""))
+15 DO SETGBL(.OUTPUT,DIEN,AFIND,"A",AFIEN)
End DoDot:3
End DoDot:2
End DoDot:1
+16 QUIT
+17 ;
RTAXNAME(NAME) ;
+1 IF '$DATA(^PXD(811.2,"B",NAME))
QUIT NAME
+2 NEW CNT,FOUND,RESULT,TEMP
+3 SET TEMP=NAME
SET CNT=0
+4 IF $LENGTH(NAME)>64
SET TEMP=$EXTRACT(NAME,1,60)
+5 SET TEMP=TEMP_"*"
+6 IF '$DATA(^PXD(811.2,"B",TEMP))
QUIT TEMP
+7 SET FOUND=0
+8 FOR
Begin DoDot:1
+9 SET CNT=CNT+1
+10 IF '$DATA(^PXD(811.2,"B",TEMP_CNT))
SET RESULT=TEMP_CNT
SET FOUND=1
End DoDot:1
IF FOUND=1
QUIT
+11 QUIT RESULT
+12 ;
SETGBL(ARRAY,DIEN,VARP,LOC,IEN) ;
+1 NEW FIEN,GBL
+2 SET GBL=$PIECE(VARP,";",2)
SET FIEN=$PIECE(VARP,";")
+3 IF LOC="A"
SET ARRAY(GBL,FIEN,DIEN,LOC,IEN)=""
QUIT
+4 SET ARRAY(GBL,FIEN,DIEN,LOC)=""
+5 QUIT
+6 ;
NATCONV(DIEN) ; entry point to convert a local dialog to a national dialog
+1 NEW ARRAY,IEN
+2 DO DITEMAR(DIEN,.ARRAY)
+3 SET IEN=0
FOR
SET IEN=$ORDER(ARRAY(IEN))
IF IEN'>0
QUIT
Begin DoDot:1
+4 DO DMAKENAT(IEN)
End DoDot:1
+5 DO DMAKENAT(DIEN)
+6 QUIT
+7 ;
