TIU169D ; SLC/MAM - Data, etc for Option for TIU*1*169 ; 10/4/2004
;;1.0;Text Integration Utilities;**169**;Jun 20, 1997
;
ADDITEM(NUM,TIUDA,PIEN) ; Add DDEF TIUDA to Parent; Return Item IEN
N MENUTXT,TIUFPRIV,TIUFISCR
N DIE,DR
S TIUFPRIV=1
N DA,DIC,DLAYGO,X,Y
N I,DIY
S DA(1)=PIEN
S DIC="^TIU(8925.1,"_DA(1)_",10,",DIC(0)="LX"
S DLAYGO=8925.14
; -- If TIUDA is say, x, and Parent has x as IFN in Item subfile,
; code finds item x under parent instead of creating a new item,
; so don't use "`"_TIUDA:
S X=^TMP("TIU169",$J,"BASICS",NUM,"NAME")
; -- Make sure the DDEF it adds is TIUDA and not another w same name:
S TIUFISCR=TIUDA ; activates item screen on fld 10, Subfld .01 in DD
D ^DIC I Y'>0!($P(Y,U,3)'=1) S ^TMP("TIU169ERR",$J,NUM)="ADDITEM"
Q Y
;
FILEITEM(NUM,PIEN,ITEMDA) ; File Menu Text for DDEF item ITEMDA
;under parent
N TIUFPRIV,MENUTXT,ITEMFDA
K TIUIERR
S TIUFPRIV=1,MENUTXT=$G(^TMP("TIU169",$J,"DATA",NUM,"MENUTXT"))
S ITEMFDA(8925.14,ITEMDA_","_PIEN_",",4)=MENUTXT
D FILE^DIE("TE","ITEMFDA","TIUIERR")
I $D(TIUIERR) S ^TMP("TIU169ERR",$J,NUM)="FILEITEM"
Q
;
DELETE(TIUDA,PIEN,ITEMDA) ; Delete DDEF TIUDA; If parent PIEN and
;Item IEN ITEMDA sent, first delete item from parent
N DA,DIK,X,Y,I
I $G(PIEN),$G(ITEMDA) D
. S DA(1)=PIEN,DA=ITEMDA,DIK="^TIU(8925.1,DA(1),10," D ^DIK
N DA,DIK
S DA=TIUDA,DIK="^TIU(8925.1," D ^DIK
Q
;
PRINT ; Print out results from message array ^TMP("TIU169MSG",$J
N TIUCNT,TIUCONT
I $D(ZTQUEUED) S ZTREQ="@" ; Tell TaskMan to delete Task log entry
I $E(IOST)="C-" W @IOF,!
S TIUCNT="",TIUCONT=1
F S TIUCNT=$O(^TMP("TIU169MSG",$J,TIUCNT)) Q:TIUCNT="" D Q:'TIUCONT
. S TIUCONT=$$SETCONT Q:'TIUCONT
. W ^TMP("TIU169MSG",$J,TIUCNT),!
PRINTX Q
;
STOP() ;on screen paging check
; quits TIUCONT=1 if cont. ELSE quits TIUCONT=0
N DIR,Y,TIUCONT
S DIR(0)="E" D ^DIR
S TIUCONT=Y
I TIUCONT W @IOF,!
Q TIUCONT
;
SETCONT() ; D form feed, Set TIUCONT
N TIUCONT
S TIUCONT=1
I $E(IOST)="C-" G SETX:$Y+5<IOSL
I $E(IOST)="C-" S TIUCONT=$$STOP G SETX
G:$Y+8<IOSL SETX
W @IOF
SETX Q TIUCONT
;
SETDATA ; Set more data for DDEFS
; Basic data set in TIUEN169. See rtn TIUEN169 for numbered list of
;DDEF Names and Types.
; -- Set Print Name, Owner, Status, National, Exterior Type into
; FILEDATA node of data array ^TMP("TIU169":
; -- First, set Docmt Class (#1):
N NUM S NUM=1 D
. S ^TMP("TIU169",$J,"FILEDATA",NUM,.03)=$G(^TMP("TIU169",$J,"BASICS",NUM,"NAME")) ;Name node MUST exist. Using $G to ease testing of fewer DDEFS.
. S ^TMP("TIU169",$J,"FILEDATA",NUM,.06)="CLINICAL COORDINATOR"
. S ^TMP("TIU169",$J,"FILEDATA",NUM,.07)="ACTIVE"
. S ^TMP("TIU169",$J,"FILEDATA",NUM,.13)="YES"
. S ^TMP("TIU169",$J,"FILEDATA",1,.04)="DOCUMENT CLASS"
; -- Set Titles:
N NUM F NUM=2:1:58 D
. S ^TMP("TIU169",$J,"FILEDATA",NUM,.03)=$G(^TMP("TIU169",$J,"BASICS",NUM,"NAME"))
. S ^TMP("TIU169",$J,"FILEDATA",NUM,.06)="CLINICAL COORDINATOR"
. S ^TMP("TIU169",$J,"FILEDATA",NUM,.07)="INACTIVE"
. S ^TMP("TIU169",$J,"FILEDATA",NUM,.13)="NO"
. S ^TMP("TIU169",$J,"FILEDATA",NUM,.04)="TITLE"
; -- Set Parent and Menu Text into DATA nodes of ^TMP("TIU169":
; -- Set PIEN node = IEN of parent if known, or if not,
; set PNUM node = DDEF# of parent
; Parent must exist by the time this DDEF is created.
; -- Parent of DC is CL Progress Notes:
S ^TMP("TIU169",$J,"DATA",1,"PIEN")=3 ;PN IEN is 3
; -- Parent of Titles is DC:
N NUM F NUM=2:1:58 S ^TMP("TIU169",$J,"DATA",NUM,"PNUM")=1 ; DC DDEF #
; -- Menutext:
F NUM=1:1:58 S ^TMP("TIU169",$J,"DATA",NUM,"MENUTXT")=$P($T(MENUTXT+NUM),";;",2,99)
Q
;
;;C&P Exam Reports
;;Examination
;;Multiple Exam
;;Acromegaly
;;A&A or Housebound
;;Arrhythmias
;;Arteries, Veins, Mis
;;Audio
;;Bones
;;Brain and Spinal Cor
;;Chronic Fatigue Synd
;;Cold Injury Protocol
;;Cranial Nerves
;;Cushing's Syndrome
;;Dental and Oral
;;Diabetes Mellitus
;;Digestive Conditions
;;Ear Disease
;;Eating Disorders
;;Endocrine Diseases
;;Epilepsy and Narcole
;;Esophagus & Hiatal H
;;Eye Examination
;;Feet
;;Fibromyalgia
;;General Medical
;;Genitourinary Exam
;;Gulf War
;;Gynecological Condit
;;Hand, Thumb, & Finge
;;Heart
;;Hemic Disorders
;;HIV-Related Illness
;;Hypertension
;;Infectious, Immune,
;;Intestines
;;Joints
;;Liver, Gall Bladder,
;;Lymphatic Disorders
;;Mental Disorders
;;Mouth, Lips, and Ton
;;Muscles
;;Neurological Disorde
;;Nose, Sinus, Larynx,
;;Peripheral Nerves
;;POW Protocol
;;PTSD, Initial
;;PTSD, Review
;;Pulmonary Tuberculos
;;Rectum and Anus
;;Residuals of Amputat
;;Respiratory
;;Scars
;;Sense of Smell and T
;;Skin Diseases
;;Spine
;;Stomach, Duodenum, P
;;Thyroid and Parathyr
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIU169D 4955 printed Oct 16, 2024@18:38:59 Page 2
TIU169D ; SLC/MAM - Data, etc for Option for TIU*1*169 ; 10/4/2004
+1 ;;1.0;Text Integration Utilities;**169**;Jun 20, 1997
+2 ;
ADDITEM(NUM,TIUDA,PIEN) ; Add DDEF TIUDA to Parent; Return Item IEN
+1 NEW MENUTXT,TIUFPRIV,TIUFISCR
+2 NEW DIE,DR
+3 SET TIUFPRIV=1
+4 NEW DA,DIC,DLAYGO,X,Y
+5 NEW I,DIY
+6 SET DA(1)=PIEN
+7 SET DIC="^TIU(8925.1,"_DA(1)_",10,"
SET DIC(0)="LX"
+8 SET DLAYGO=8925.14
+9 ; -- If TIUDA is say, x, and Parent has x as IFN in Item subfile,
+10 ; code finds item x under parent instead of creating a new item,
+11 ; so don't use "`"_TIUDA:
+12 SET X=^TMP("TIU169",$JOB,"BASICS",NUM,"NAME")
+13 ; -- Make sure the DDEF it adds is TIUDA and not another w same name:
+14 ; activates item screen on fld 10, Subfld .01 in DD
SET TIUFISCR=TIUDA
+15 DO ^DIC
IF Y'>0!($PIECE(Y,U,3)'=1)
SET ^TMP("TIU169ERR",$JOB,NUM)="ADDITEM"
+16 QUIT Y
+17 ;
FILEITEM(NUM,PIEN,ITEMDA) ; File Menu Text for DDEF item ITEMDA
+1 ;under parent
+2 NEW TIUFPRIV,MENUTXT,ITEMFDA
+3 KILL TIUIERR
+4 SET TIUFPRIV=1
SET MENUTXT=$GET(^TMP("TIU169",$JOB,"DATA",NUM,"MENUTXT"))
+5 SET ITEMFDA(8925.14,ITEMDA_","_PIEN_",",4)=MENUTXT
+6 DO FILE^DIE("TE","ITEMFDA","TIUIERR")
+7 IF $DATA(TIUIERR)
SET ^TMP("TIU169ERR",$JOB,NUM)="FILEITEM"
+8 QUIT
+9 ;
DELETE(TIUDA,PIEN,ITEMDA) ; Delete DDEF TIUDA; If parent PIEN and
+1 ;Item IEN ITEMDA sent, first delete item from parent
+2 NEW DA,DIK,X,Y,I
+3 IF $GET(PIEN)
IF $GET(ITEMDA)
Begin DoDot:1
+4 SET DA(1)=PIEN
SET DA=ITEMDA
SET DIK="^TIU(8925.1,DA(1),10,"
DO ^DIK
End DoDot:1
+5 NEW DA,DIK
+6 SET DA=TIUDA
SET DIK="^TIU(8925.1,"
DO ^DIK
+7 QUIT
+8 ;
PRINT ; Print out results from message array ^TMP("TIU169MSG",$J
+1 NEW TIUCNT,TIUCONT
+2 ; Tell TaskMan to delete Task log entry
IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+3 IF $EXTRACT(IOST)="C-"
WRITE @IOF,!
+4 SET TIUCNT=""
SET TIUCONT=1
+5 FOR
SET TIUCNT=$ORDER(^TMP("TIU169MSG",$JOB,TIUCNT))
if TIUCNT=""
QUIT
Begin DoDot:1
+6 SET TIUCONT=$$SETCONT
if 'TIUCONT
QUIT
+7 WRITE ^TMP("TIU169MSG",$JOB,TIUCNT),!
End DoDot:1
if 'TIUCONT
QUIT
PRINTX QUIT
+1 ;
STOP() ;on screen paging check
+1 ; quits TIUCONT=1 if cont. ELSE quits TIUCONT=0
+2 NEW DIR,Y,TIUCONT
+3 SET DIR(0)="E"
DO ^DIR
+4 SET TIUCONT=Y
+5 IF TIUCONT
WRITE @IOF,!
+6 QUIT TIUCONT
+7 ;
SETCONT() ; D form feed, Set TIUCONT
+1 NEW TIUCONT
+2 SET TIUCONT=1
+3 IF $EXTRACT(IOST)="C-"
if $Y+5<IOSL
GOTO SETX
+4 IF $EXTRACT(IOST)="C-"
SET TIUCONT=$$STOP
GOTO SETX
+5 if $Y+8<IOSL
GOTO SETX
+6 WRITE @IOF
SETX QUIT TIUCONT
+1 ;
SETDATA ; Set more data for DDEFS
+1 ; Basic data set in TIUEN169. See rtn TIUEN169 for numbered list of
+2 ;DDEF Names and Types.
+3 ; -- Set Print Name, Owner, Status, National, Exterior Type into
+4 ; FILEDATA node of data array ^TMP("TIU169":
+5 ; -- First, set Docmt Class (#1):
+6 NEW NUM
SET NUM=1
Begin DoDot:1
+7 ;Name node MUST exist. Using $G to ease testing of fewer DDEFS.
SET ^TMP("TIU169",$JOB,"FILEDATA",NUM,.03)=$GET(^TMP("TIU169",$JOB,"BASICS",NUM,"NAME"))
+8 SET ^TMP("TIU169",$JOB,"FILEDATA",NUM,.06)="CLINICAL COORDINATOR"
+9 SET ^TMP("TIU169",$JOB,"FILEDATA",NUM,.07)="ACTIVE"
+10 SET ^TMP("TIU169",$JOB,"FILEDATA",NUM,.13)="YES"
+11 SET ^TMP("TIU169",$JOB,"FILEDATA",1,.04)="DOCUMENT CLASS"
End DoDot:1
+12 ; -- Set Titles:
+13 NEW NUM
FOR NUM=2:1:58
Begin DoDot:1
+14 SET ^TMP("TIU169",$JOB,"FILEDATA",NUM,.03)=$GET(^TMP("TIU169",$JOB,"BASICS",NUM,"NAME"))
+15 SET ^TMP("TIU169",$JOB,"FILEDATA",NUM,.06)="CLINICAL COORDINATOR"
+16 SET ^TMP("TIU169",$JOB,"FILEDATA",NUM,.07)="INACTIVE"
+17 SET ^TMP("TIU169",$JOB,"FILEDATA",NUM,.13)="NO"
+18 SET ^TMP("TIU169",$JOB,"FILEDATA",NUM,.04)="TITLE"
End DoDot:1
+19 ; -- Set Parent and Menu Text into DATA nodes of ^TMP("TIU169":
+20 ; -- Set PIEN node = IEN of parent if known, or if not,
+21 ; set PNUM node = DDEF# of parent
+22 ; Parent must exist by the time this DDEF is created.
+23 ; -- Parent of DC is CL Progress Notes:
+24 ;PN IEN is 3
SET ^TMP("TIU169",$JOB,"DATA",1,"PIEN")=3
+25 ; -- Parent of Titles is DC:
+26 ; DC DDEF #
NEW NUM
FOR NUM=2:1:58
SET ^TMP("TIU169",$JOB,"DATA",NUM,"PNUM")=1
+27 ; -- Menutext:
+28 FOR NUM=1:1:58
SET ^TMP("TIU169",$JOB,"DATA",NUM,"MENUTXT")=$PIECE($TEXT(MENUTXT+NUM),";;",2,99)
+29 QUIT
+30 ;
+1 ;;C&P Exam Reports
+2 ;;Examination
+3 ;;Multiple Exam
+4 ;;Acromegaly
+5 ;;A&A or Housebound
+6 ;;Arrhythmias
+7 ;;Arteries, Veins, Mis
+8 ;;Audio
+9 ;;Bones
+10 ;;Brain and Spinal Cor
+11 ;;Chronic Fatigue Synd
+12 ;;Cold Injury Protocol
+13 ;;Cranial Nerves
+14 ;;Cushing's Syndrome
+15 ;;Dental and Oral
+16 ;;Diabetes Mellitus
+17 ;;Digestive Conditions
+18 ;;Ear Disease
+19 ;;Eating Disorders
+20 ;;Endocrine Diseases
+21 ;;Epilepsy and Narcole
+22 ;;Esophagus & Hiatal H
+23 ;;Eye Examination
+24 ;;Feet
+25 ;;Fibromyalgia
+26 ;;General Medical
+27 ;;Genitourinary Exam
+28 ;;Gulf War
+29 ;;Gynecological Condit
+30 ;;Hand, Thumb, & Finge
+31 ;;Heart
+32 ;;Hemic Disorders
+33 ;;HIV-Related Illness
+34 ;;Hypertension
+35 ;;Infectious, Immune,
+36 ;;Intestines
+37 ;;Joints
+38 ;;Liver, Gall Bladder,
+39 ;;Lymphatic Disorders
+40 ;;Mental Disorders
+41 ;;Mouth, Lips, and Ton
+42 ;;Muscles
+43 ;;Neurological Disorde
+44 ;;Nose, Sinus, Larynx,
+45 ;;Peripheral Nerves
+46 ;;POW Protocol
+47 ;;PTSD, Initial
+48 ;;PTSD, Review
+49 ;;Pulmonary Tuberculos
+50 ;;Rectum and Anus
+51 ;;Residuals of Amputat
+52 ;;Respiratory
+53 ;;Scars
+54 ;;Sense of Smell and T
+55 ;;Skin Diseases
+56 ;;Spine
+57 ;;Stomach, Duodenum, P
+58 ;;Thyroid and Parathyr
+59 QUIT
+60 ;
