DVBAPOP2 ;ALB/JLU;another post init population routine
;;2.7;AMIE;;Apr 10, 1995
;
SETPTR ;This entry point sets up the pointers from file 396.6 to 396.7
;this data could not come in with difrom because difrom does not
;evaluate pointers.
;
N DVBX,DVBX1,DVBX2,DVBX3,DVBX4,VAR
S DVBX3=0
F DVBX=1:1 S DVBX1=$T(EXAM+DVBX) Q:DVBX1'[";;" DO
.S DVBX1=$P(DVBX1,";;",2)
.S DVBX2=$P(DVBX1,U,2)
.S DVBX1=$P(DVBX1,U,1)
.S IEN3966=$$IEN6^DVBAPOPU(DVBX1)
.Q:'+IEN3966
.S IEN3967=$$IEN7^DVBAPOPU(DVBX2)
.Q:'+IEN3967
.I $P(^DVB(396.6,IEN3966,0),U,3)'=IEN3967 DO
..S DVBX4=$P(^DVB(396.6,IEN3966,0),U,3)
..S DIE="^DVB(396.6,",DA=IEN3966,DR="2////"_IEN3967
..D ^DIE
..S DVBX3=DVBX3+1
..D BUMPBLK^DVBAPOST
..S VAR="Changed record "_IEN3966_" of the AMIE Exam File from "_DVBX4_" to "_IEN3967
..W !,VAR D BUMP^DVBAPOST(VAR)
..Q
.Q
S VAR=" - Updating AMIE Exam file pointers to the 2507 Body System file is complete"
D BUMPBLK^DVBAPOST
D BUMPBLK^DVBAPOST
W !!,VAR D BUMP^DVBAPOST(VAR)
S VAR=DVBX3_" records were updated."
W !,VAR D BUMP^DVBAPOST(VAR)
Q
;
EXAM ;
;;AGENT ORANGE^SPECIAL
;;AID AND ATTENDANCE/HOUSEBOUND^SPECIAL
;;ALIMENTARY APPENDAGES^DIGESTIVE
;;AMPUTATION STUMPS^ORTHOPEDIC
;;AUDIO^ORGANS OF SENSE
;;AUDIO-EAR DISEASE^ORGANS OF SENSE
;;BONES^ORTHOPEDIC
;;CARDIOVASCULAR (NEC)^CARDIOVASCULAR
;;CRANIAL NERVES^NEUROLOGICAL
;;CYSTITIS,BLADDER CALC.,BLADDER INJURY,PROSTATE,SURG. RESID.^GENITOURINARY
;;DENTAL^DENTAL
;;DIABETES INSIPIDUS^ENDOCRINE
;;DIABETES MELLITUS^ENDOCRINE
;;DIGESTIVE (NEC)^DIGESTIVE
;;DISEASES OF ARTERIES/VEINS^CARDIOVASCULAR
;;DISEASES OF THE HEART^CARDIOVASCULAR
;;DISEASES/INJURIES OF THE BRAIN^NEUROLOGICAL
;;DISEASES/INJURIES OF THE SPINAL CORD^NEUROLOGICAL
;;ENDOCRINE DISORDERS (NEC)^ENDOCRINE
;;EPILEPSY AND NARCOLEPSY^NEUROLOGICAL
;;ESOPHAGUS^DIGESTIVE
;;FEET^ORTHOPEDIC
;;GENERAL MEDICAL^GENERAL MEDICAL
;;GENITOURINARY (NEC)^GENITOURINARY
;;GYNECOLOGICAL^GYNECOLOGICAL
;;GYNECOLOGICAL (NEC)^GYNECOLOGICAL
;;HAND, THUMB, FINGERS^ORTHOPEDIC
;;HEMATOLOGIC DISORDERS^HEMATOLOGICAL
;;HEMATOLOGIC DISORDERS-BLOOD^HEMATOLOGICAL
;;HEMATOLOGIC DISORDERS-LYMPHATIC^HEMATOLOGICAL
;;HEMATOLOGICAL (NEC)^HEMATOLOGICAL
;;HIGHER LEVEL AID AND ATTENDANCE^SPECIAL
;;HIP^ORTHOPEDIC
;;HYPERPARATHYROIDISM^ENDOCRINE
;;HYPERPITUITARISM (CUSHINGS SYNDROME)^ENDOCRINE
;;HYPERTENSION^CARDIOVASCULAR
;;HYPERTHYROIDISM, THYROID ADENOMA^ENDOCRINE
;;HYPOTHYROIDISM^ENDOCRINE
;;INTESTINE^DIGESTIVE
;;JOINTS^ORTHOPEDIC
;;LOSS OF PENIS, ALL OR PARTIAL^GENITOURINARY
;;MALIGNANCIES OR TUBERCULOSIS^GENITOURINARY
;;MAMMARY^GYNECOLOGICAL
;;MENTAL (NEC)^MENTAL
;;MENTAL DISORDERS^MENTAL
;;MISCELLANEOUS NEUROLOGICAL DISORDERS^NEUROLOGICAL
;;MOUTH AND THROAT^ORGANS OF SENSE
;;MUSCLES^ORTHOPEDIC
;;MUSCULOSKELETAL (NEC)^ORTHOPEDIC
;;NECK - NOT SPINAL CONDITION^ORTHOPEDIC
;;NEPHRITIS, ALL FORMS EXCEPT CHRONIC PYELONEPHRITIS^NEPHROLOGICAL
;;NEPHROLOGICAL^NEPHROLOGICAL
;;NEPHROLOGICAL (NEC)^NEPHROLOGICAL
;;NEUROLOGICAL (NEC)^NEUROLOGICAL
;;NON-TUBERCULOSIS DISEASES AND INJURIES^PULMONARY
;;NOSE AND SINUSES^ORGANS OF SENSE
;;NOSE AND THROAT (PULMONARY)^PULMONARY
;;ORGANS OF SENSE (NEC)^ORGANS OF SENSE
;;OTHER GENITOURINARY^GENITOURINARY
;;PERIPHERAL NERVES^NEUROLOGICAL
;;PITUITARY TUMORS^ENDOCRINE
;;POST-TRAUMATIC STRESS DISORDER^MENTAL
;;PRISONER OF WAR^SPECIAL
;;PULMONARY (NEC)^PULMONARY
;;PULMONARY TUBERCULOSIS AND TUBERCULOSIS DISEASES^PULMONARY
;;PYELITIS, NEPHROLITHIAIS, ETC.^GENITOURINARY
;;RECTUM AND ANUS^DIGESTIVE
;;REGULAR AID AND ATTENDANCE/HOUSEBOUND^SPECIAL
;;RESPIRATORY MANIF. OF DISEASES OF OTHER SYSTEMS^PULMONARY
;;SCARS^ORTHOPEDIC
;;SCARS (BURN)^SKIN
;;SCARS (SKIN)^SKIN
;;SENSE OF SMELL^ORGANS OF SENSE
;;SENSE OF TASTE^ORGANS OF SENSE
;;SKIN (NEC)^SKIN
;;SKIN (OTHER THAN SCARS)^SKIN
;;SPINE^ORTHOPEDIC
;;STOMACH^DIGESTIVE
;;SYSTEMIC CONDITIONS^SYSTEMIC
;;TESTES, TRAUMA OR DISEASE^GENITOURINARY
;;TRACHEA AND BRONCHI^PULMONARY
;;URETHRAL FISTULA^GENITOURINARY
;;VISUAL^ORGANS OF SENSE
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDVBAPOP2 4143 printed Oct 16, 2024@17:42:40 Page 2
DVBAPOP2 ;ALB/JLU;another post init population routine
+1 ;;2.7;AMIE;;Apr 10, 1995
+2 ;
SETPTR ;This entry point sets up the pointers from file 396.6 to 396.7
+1 ;this data could not come in with difrom because difrom does not
+2 ;evaluate pointers.
+3 ;
+4 NEW DVBX,DVBX1,DVBX2,DVBX3,DVBX4,VAR
+5 SET DVBX3=0
+6 FOR DVBX=1:1
SET DVBX1=$TEXT(EXAM+DVBX)
if DVBX1'[";;"
QUIT
Begin DoDot:1
+7 SET DVBX1=$PIECE(DVBX1,";;",2)
+8 SET DVBX2=$PIECE(DVBX1,U,2)
+9 SET DVBX1=$PIECE(DVBX1,U,1)
+10 SET IEN3966=$$IEN6^DVBAPOPU(DVBX1)
+11 if '+IEN3966
QUIT
+12 SET IEN3967=$$IEN7^DVBAPOPU(DVBX2)
+13 if '+IEN3967
QUIT
+14 IF $PIECE(^DVB(396.6,IEN3966,0),U,3)'=IEN3967
Begin DoDot:2
+15 SET DVBX4=$PIECE(^DVB(396.6,IEN3966,0),U,3)
+16 SET DIE="^DVB(396.6,"
SET DA=IEN3966
SET DR="2////"_IEN3967
+17 DO ^DIE
+18 SET DVBX3=DVBX3+1
+19 DO BUMPBLK^DVBAPOST
+20 SET VAR="Changed record "_IEN3966_" of the AMIE Exam File from "_DVBX4_" to "_IEN3967
+21 WRITE !,VAR
DO BUMP^DVBAPOST(VAR)
+22 QUIT
End DoDot:2
+23 QUIT
End DoDot:1
+24 SET VAR=" - Updating AMIE Exam file pointers to the 2507 Body System file is complete"
+25 DO BUMPBLK^DVBAPOST
+26 DO BUMPBLK^DVBAPOST
+27 WRITE !!,VAR
DO BUMP^DVBAPOST(VAR)
+28 SET VAR=DVBX3_" records were updated."
+29 WRITE !,VAR
DO BUMP^DVBAPOST(VAR)
+30 QUIT
+31 ;
EXAM ;
+1 ;;AGENT ORANGE^SPECIAL
+2 ;;AID AND ATTENDANCE/HOUSEBOUND^SPECIAL
+3 ;;ALIMENTARY APPENDAGES^DIGESTIVE
+4 ;;AMPUTATION STUMPS^ORTHOPEDIC
+5 ;;AUDIO^ORGANS OF SENSE
+6 ;;AUDIO-EAR DISEASE^ORGANS OF SENSE
+7 ;;BONES^ORTHOPEDIC
+8 ;;CARDIOVASCULAR (NEC)^CARDIOVASCULAR
+9 ;;CRANIAL NERVES^NEUROLOGICAL
+10 ;;CYSTITIS,BLADDER CALC.,BLADDER INJURY,PROSTATE,SURG. RESID.^GENITOURINARY
+11 ;;DENTAL^DENTAL
+12 ;;DIABETES INSIPIDUS^ENDOCRINE
+13 ;;DIABETES MELLITUS^ENDOCRINE
+14 ;;DIGESTIVE (NEC)^DIGESTIVE
+15 ;;DISEASES OF ARTERIES/VEINS^CARDIOVASCULAR
+16 ;;DISEASES OF THE HEART^CARDIOVASCULAR
+17 ;;DISEASES/INJURIES OF THE BRAIN^NEUROLOGICAL
+18 ;;DISEASES/INJURIES OF THE SPINAL CORD^NEUROLOGICAL
+19 ;;ENDOCRINE DISORDERS (NEC)^ENDOCRINE
+20 ;;EPILEPSY AND NARCOLEPSY^NEUROLOGICAL
+21 ;;ESOPHAGUS^DIGESTIVE
+22 ;;FEET^ORTHOPEDIC
+23 ;;GENERAL MEDICAL^GENERAL MEDICAL
+24 ;;GENITOURINARY (NEC)^GENITOURINARY
+25 ;;GYNECOLOGICAL^GYNECOLOGICAL
+26 ;;GYNECOLOGICAL (NEC)^GYNECOLOGICAL
+27 ;;HAND, THUMB, FINGERS^ORTHOPEDIC
+28 ;;HEMATOLOGIC DISORDERS^HEMATOLOGICAL
+29 ;;HEMATOLOGIC DISORDERS-BLOOD^HEMATOLOGICAL
+30 ;;HEMATOLOGIC DISORDERS-LYMPHATIC^HEMATOLOGICAL
+31 ;;HEMATOLOGICAL (NEC)^HEMATOLOGICAL
+32 ;;HIGHER LEVEL AID AND ATTENDANCE^SPECIAL
+33 ;;HIP^ORTHOPEDIC
+34 ;;HYPERPARATHYROIDISM^ENDOCRINE
+35 ;;HYPERPITUITARISM (CUSHINGS SYNDROME)^ENDOCRINE
+36 ;;HYPERTENSION^CARDIOVASCULAR
+37 ;;HYPERTHYROIDISM, THYROID ADENOMA^ENDOCRINE
+38 ;;HYPOTHYROIDISM^ENDOCRINE
+39 ;;INTESTINE^DIGESTIVE
+40 ;;JOINTS^ORTHOPEDIC
+41 ;;LOSS OF PENIS, ALL OR PARTIAL^GENITOURINARY
+42 ;;MALIGNANCIES OR TUBERCULOSIS^GENITOURINARY
+43 ;;MAMMARY^GYNECOLOGICAL
+44 ;;MENTAL (NEC)^MENTAL
+45 ;;MENTAL DISORDERS^MENTAL
+46 ;;MISCELLANEOUS NEUROLOGICAL DISORDERS^NEUROLOGICAL
+47 ;;MOUTH AND THROAT^ORGANS OF SENSE
+48 ;;MUSCLES^ORTHOPEDIC
+49 ;;MUSCULOSKELETAL (NEC)^ORTHOPEDIC
+50 ;;NECK - NOT SPINAL CONDITION^ORTHOPEDIC
+51 ;;NEPHRITIS, ALL FORMS EXCEPT CHRONIC PYELONEPHRITIS^NEPHROLOGICAL
+52 ;;NEPHROLOGICAL^NEPHROLOGICAL
+53 ;;NEPHROLOGICAL (NEC)^NEPHROLOGICAL
+54 ;;NEUROLOGICAL (NEC)^NEUROLOGICAL
+55 ;;NON-TUBERCULOSIS DISEASES AND INJURIES^PULMONARY
+56 ;;NOSE AND SINUSES^ORGANS OF SENSE
+57 ;;NOSE AND THROAT (PULMONARY)^PULMONARY
+58 ;;ORGANS OF SENSE (NEC)^ORGANS OF SENSE
+59 ;;OTHER GENITOURINARY^GENITOURINARY
+60 ;;PERIPHERAL NERVES^NEUROLOGICAL
+61 ;;PITUITARY TUMORS^ENDOCRINE
+62 ;;POST-TRAUMATIC STRESS DISORDER^MENTAL
+63 ;;PRISONER OF WAR^SPECIAL
+64 ;;PULMONARY (NEC)^PULMONARY
+65 ;;PULMONARY TUBERCULOSIS AND TUBERCULOSIS DISEASES^PULMONARY
+66 ;;PYELITIS, NEPHROLITHIAIS, ETC.^GENITOURINARY
+67 ;;RECTUM AND ANUS^DIGESTIVE
+68 ;;REGULAR AID AND ATTENDANCE/HOUSEBOUND^SPECIAL
+69 ;;RESPIRATORY MANIF. OF DISEASES OF OTHER SYSTEMS^PULMONARY
+70 ;;SCARS^ORTHOPEDIC
+71 ;;SCARS (BURN)^SKIN
+72 ;;SCARS (SKIN)^SKIN
+73 ;;SENSE OF SMELL^ORGANS OF SENSE
+74 ;;SENSE OF TASTE^ORGANS OF SENSE
+75 ;;SKIN (NEC)^SKIN
+76 ;;SKIN (OTHER THAN SCARS)^SKIN
+77 ;;SPINE^ORTHOPEDIC
+78 ;;STOMACH^DIGESTIVE
+79 ;;SYSTEMIC CONDITIONS^SYSTEMIC
+80 ;;TESTES, TRAUMA OR DISEASE^GENITOURINARY
+81 ;;TRACHEA AND BRONCHI^PULMONARY
+82 ;;URETHRAL FISTULA^GENITOURINARY
+83 ;;VISUAL^ORGANS OF SENSE