- 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 ;
