- 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 Feb 19, 2025@00:04:49 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 ;