BDGPOST1 ; IHS/ANMC/LJF - PIMS POSTINIT ; [ 01/22/2004 3:56 PM ]
;;5.3;PIMS;;APR 26, 2002
; post init code called by BDGPOST
;
Q
;
PCCLINK ;EP; add primary facility to PCC Master Control file
D BMES^XPDUTL("Adding PIMS to PCC Master Control file...")
NEW DIV,FAC,PKG
S DIV=$P($G(^DG(43,1,"GL")),U,3) Q:'DIV ;no primary division
S FAC=$P($G(^DG(40.8,+DIV,0)),U,7) Q:'FAC ;no facility pointer
Q:'$D(^APCCCTRL(FAC,0)) ;not in PCC Master file
S PKG=$O(^DIC(9.4,"C","PIMS",0)) Q:'PKG ;no PIMS pkg on file
Q:$D(^APCCCTRL(FAC,11,PKG,0)) ;already in PCC file
;
NEW DIC,X,DD,DO,DLAYGO,DINUM,Y,DIE,DA,DR
S DIC="^APCCCTRL("_FAC_",11,",X="PIMS",DINUM=PKG,DIC(0)="L"
S DLAYGO=9001000.011,DIC("P")="9001000.011PA"
D FILE^DICN Q:Y<1
;
S DIE="^APCCCTRL("_FAC_",11,",DA=PKG,DA(1)=FAC
S DR=".02///"_$S($P($G(^DG(43,1,9999999)),U,2)="Y":1,1:0)
D ^DIE
K X S X=$$REPEAT^XLFSTR(" ",20)_"Done." D MES^XPDUTL(.X)
Q
;
PARAM ;EP; copy ADT parameters from file 43 to 9009020.1
; old data to stay until future patch
; Copies only if site has parameters set already
;
D BMES^XPDUTL("Copying IHS ADT Parameter fields to new file...")
;
NEW DIV,DATA,I,DIK
S DIV=$P($G(^DG(43,1,"GL")),U,3) Q:'DIV ;no primary division
Q:$D(^BDGPAR(DIV,0)) ;already set up
;
S ^BDGPAR(DIV,0)=DIV,$P(^BDGPAR(0),U,3)=DIV
S $P(^BDGPAR(0),U,4)=$P(^BDGPAR(0),U,4)+1
;
S DATA=$G(^DG(43,1,9999999)) I DATA]"" D
. F I="5;5","6;2" S $P(^BDGPAR(DIV,0),U,$P(I,";",2))=$P(DATA,U,+I)
;
S DATA=$G(^DG(43,1,9999999.01)) I DATA]"" D
. F I="1;10","2;1","3;2","4;3","5;4","6;6","7;8" D
.. S $P(^BDGPAR(DIV,1),U,$P(I,";",2))=$P(DATA,U,+I)
;
S DATA=$G(^DG(43,1,9999999.02)) I DATA]"" D
. F I="1;5;1","2;7;1","3;12;0","4;8;0" D
.. S $P(^BDGPAR(DIV,$P(I,";",3)),U,$P(I,";",2))=$P(DATA,U,+I)
;
;IHS/ITSC/LJF 1/9/2004 convert Y/N answers to 1/0 answers
S DATA=$G(^BDGPAR(DIV,1)) I DATA]"" F I=1:1:14 D S ^BDGPAR(DIV,1)=DATA
. I $P(DATA,U,I)="Y" S $P(DATA,U,I)=1
. I $P(DATA,U,I)="N" S $P(DATA,U,I)=0
;
;IHS/ITSC/WAR 6/18/03 - Added code to update the 'VERSION' node in
; DG(43, This uses the 'C' xref in the pkg file.
S DATA=$$VERSION^XPDUTL("PIMS") I DATA]"" D
. S ^DG(43,1,"VERSION")=DATA
;
S DIK="^BDGPAR(" D IXALL^DIK
K X S X=$$REPEAT^XLFSTR(" ",20)_"Done." D MES^XPDUTL(.X)
Q
;
;IHS/ITSC/WAR 10/17/03 added - updates the ADT ver# in pkg file
;IHS/ITSC/LJF 1/16/2004 added more updates
PKGFILE ;EP
NEW VER,BDGV,BDGN,X,DA,DIC,Y,DIE,DR
I $D(XPDNM) S VER=$$VER^XPDUTL(XPDNM)
I $G(VER)]"" D
.; update current version field
.S BDGN=$O(^DIC(9.4,"C","DG",0)) Q:'BDGN
.S ^DIC(9.4,BDGN,"VERSION")=VER
.;
.; clean up old 5.3 test versions
.S BDGV=0 F S BDGV=$O(^DIC(9.4,BDGN,22,"B",BDGV)) Q:BDGV="" D
..I BDGV["5.3",BDGV'=5.3 D
...S DIE="^DIC(9.4,"_BDGN_",22,",DA(1)=BDGN,DR=".01///@"
...S DA=$O(^DIC(9.4,BDGN,22,"B",BDGV,0)) Q:'DA
...D ^DIE
.;
.; now add version multiple without test version #
.S DIC="^DIC(9.4,"_BDGN_",22,",DIC(0)="L",X=5.3
.S DIC("P")=$P(^DD(9.4,22,0),U,2)
.S DIC("DR")="2///"_DT_";3///`"_DUZ,DA(1)=BDGN
.D ^DIC
;
D PATCHES^BDGPOST5 ;add patch history
Q
CHRTDEF ;EP; copy chart deficiency items to new file
; ^ADGCD( -> ^BDGCD( will keep old data until future patch
;
Q:$O(^BDGCD(0)) ;already has data
;
D BMES^XPDUTL("Copying Chart Deficiency entries to new file...")
NEW IEN,DIK
S IEN=0 F S IEN=$O(^ADGCD(IEN)) Q:'IEN D
. Q:$G(^ADGCD(IEN,0))="" ;bad entry
. S ^BDGCD(IEN,0)=^ADGCD(IEN,0)
;
; set zero node of file
S $P(^BDGCD(0),U,3,4)=$P(^ADGCD(0),U,3,4)
; index file
S DIK="^BDGCD(" D IXALL^DIK
K X S X=$$REPEAT^XLFSTR(" ",20)_"Done." D MES^XPDUTL(.X)
Q
;
OLDFILES ;EP; change name of old files where new file uses same name
D BMES^XPDUTL("Changing name of obsolete files...")
NEW DIE,DA,DR,X
S DIE="^DIC("
F DA=9009011,9009011.5,9009013,9009013.1,9009013.5,9009015 D
. S X=$P($G(^DIC(DA,0)),U) Q:X="" Q:X["-OLD"
. S DR=".01///"_X_"-OLD"
. D ^DIE
K X S X=$$REPEAT^XLFSTR(" ",20)_"Done." D MES^XPDUTL(.X)
Q
;
ADTTMPL ;EP; edit ADT Template entries that could not pass via KIDS
D BMES^XPDUTL("Fixing ADT Template entries...")
NEW DGEDIT,DA,DIE,DR
S DGEDIT="",DIE=43.7
S DA=2,DR="6///DG SI LIST" D ^DIE
S DA=3,DR="6///DG FEMALE INPATIENTS" D ^DIE
K X S X=$$REPEAT^XLFSTR(" ",20)_"Done." D MES^XPDUTL(.X)
Q
;
FACMOV ;EP; add new facility movement type (WARD TRANSFER ONLY)
; used when adding ward transfers non-interactively
Q:$D(^DG(405.1,"B","WARD TRANSFER ONLY"))
D BMES^XPDUTL("Adding WARD TRANSFER ONLY to file 405.1...")
NEW DIC,DD,DO,X,DLAYGO,DA,Y
S DIC="^DG(405.1,",X="WARD TRANSFER ONLY",DIC(0)="L",DLAYGO=405.1
S DIC("DR")=".02///2;.03///INTERWARD TRANSFER;.04///1;.05///0"
D FILE^DICN K DIC
I Y<1 K X S X=$$REPEAT^XLFSTR(" ",10)_"Error adding to file 405.1." D MES^XPDUTL(.X) Q
;
S DIC="^DG(405.1,"_(+Y)_",""F"",",DA(1)=+Y,DIC(0)="L",DLAYGO=405.11
S DIC("P")="405.11PA"
F BDG=1:1:8 S X=$P($T(MOV+BDG),";;",2) D ^DIC
K X S X=$$REPEAT^XLFSTR(" ",20)_"Done." D MES^XPDUTL(.X)
Q
;
MOV ;;
;;DIRECT;;
;;TRANS-NON IHS HOSPITAL;;
;;TRANS-IHS HOSPITAL;;
;;REFERRED FROM IHS CLINIC;;
;;OTHER;;
;;PROVIDER/SPECIALTY CHANGE;;
;;INTERWARD TRANSFER;;
;;WARD TRANSFER ONLY;;
;
;
TRSPEC ;EP; add treating specialty entries
; 1. add inpatient ones if not in file
; 2. add observation ones
D BMES^XPDUTL("Adding Observation Treating Specialties...")
NEW IEN,CODE
S (DIC,DLAYGO)=45.7,DIC(0)="L"
F BDGI=1:1:41 S CODE=$P($T(TS+BDGI),";;",2) D
. I $O(^DIC(45.7,"CIHS",CODE,0)) Q ;already has service
. K DD,DO S X=$P($T(TS+BDGI),";;",3),ABBRV=$P($T(TS+BDGI),";;",4)
. S DIC("DR")="9999999.01///"_CODE_";99///"_ABBRV D FILE^DICN
K X S X=$$REPEAT^XLFSTR(" ",20)_"Done." D MES^XPDUTL(.X)
Q
;
TS ;; Inpatient Treating Specialties
;;01;;DENTAL;;DEN;;
;;02;;OTOLARYNGOLOGY;;ENT;;
;;03;;GENERAL MEDICINE;;GMED;;
;;04;;GENERAL SURGERY;;SUR;;
;;05;;GYNECOLOGY;;GYN;;
;;06;;INTERNAL MEDICINE;;IMED;;
;;07;;NEWBORN;;NEW;;
;;08;;OBSTETRICS;;OB;;
;;09;;OPHTHALMOLOGY;;EYE;;
;;10;;ORTHOPEDICS;;ORTHO;;
;;11;;PEDIATRICS;;PEDS;;
;;12;;PSYCHIATRIC MENTAL HEALTH;;PSYCH;;
;;13;;TUBERCULOSIS;;TB;;
;;14;;OTHER;;OTHER;;
;;15;;ALCOHOL/SUBSTANCE ABUSE;;ALCOH;;
;;16;;PLASTIC SURGERY;;PSUR;;
;;17;;FAMILY PRACTICE;;FAMP;;
;;18;;UROLOGY;;URO;;
;;19;;PODIATRY;;POD;;
;;20;;NEUROLOGY;;NEURO;;
;;21;;SWING BED;;SWING;;
;;22;;NURSE-MIDWIFERY SERVICE;;NRSMW;;
;;01O;;DENTAL OBSERVATION;;DENO;;
;;02O;;ENT OBSERVATION;;ENTO;;
;;03O;;MEDICINE OBSERVATION;;MEDO;;
;;04O;;SURGERY OBSERVATION;;SURO;;
;;05O;;GYN OBSERVATION;;GYNO;;
;;06O;;INTERNAL MED OBSERVATION;;IMEDO;;
;;08O;;OBSTETRICS OBSERVATION;;OBO;;
;;09O;;OPHTHALMOLOGY OBSERVATION;;EYEO;;
;;10O;;ORTHOPEDICS OBSERVATION;;ORTO;;
;;11O;;PEDIATRICS OBSERVATION;;PEDO;;
;;12O;;MENTAL HEALTH OBSERVATION;;MHO;;
;;13O;;TUBERCULOSIS OBSERVATION;;TBO;;
;;15O;;SUBSTANCE ABUSE OBSERVATION;;ALCOO;;
;;16O;;PLASTIC SURGERY OBSERVATION;;PSURO;;
;;17O;;FAMILY PRACTICE OBSERVATION;;FAMPO;;
;;18O;;UROLOGY OBSERVATION;;UROO;;
;;19O;;PODIATRY OBSERVATION;;PODO;;
;;20O;;NEUROLOGY OBSERVATION;;NEUOB;;
;;22O;;NURSE-MIDWIFERY OBSERVATION;;NRSOB;;
BDGPOST1 ; IHS/ANMC/LJF - PIMS POSTINIT ; [ 01/22/2004 3:56 PM ]
+1 ;;5.3;PIMS;;APR 26, 2002
+2 ; post init code called by BDGPOST
+3 ;
+4 QUIT
+5 ;
PCCLINK ;EP; add primary facility to PCC Master Control file
+1 DO BMES^XPDUTL("Adding PIMS to PCC Master Control file...")
+2 NEW DIV,FAC,PKG
+3 ;no primary division
SET DIV=$PIECE($GET(^DG(43,1,"GL")),U,3)
IF 'DIV
QUIT
+4 ;no facility pointer
SET FAC=$PIECE($GET(^DG(40.8,+DIV,0)),U,7)
IF 'FAC
QUIT
+5 ;not in PCC Master file
IF '$DATA(^APCCCTRL(FAC,0))
QUIT
+6 ;no PIMS pkg on file
SET PKG=$ORDER(^DIC(9.4,"C","PIMS",0))
IF 'PKG
QUIT
+7 ;already in PCC file
IF $DATA(^APCCCTRL(FAC,11,PKG,0))
QUIT
+8 ;
+9 NEW DIC,X,DD,DO,DLAYGO,DINUM,Y,DIE,DA,DR
+10 SET DIC="^APCCCTRL("_FAC_",11,"
SET X="PIMS"
SET DINUM=PKG
SET DIC(0)="L"
+11 SET DLAYGO=9001000.011
SET DIC("P")="9001000.011PA"
+12 DO FILE^DICN
IF Y<1
QUIT
+13 ;
+14 SET DIE="^APCCCTRL("_FAC_",11,"
SET DA=PKG
SET DA(1)=FAC
+15 SET DR=".02///"_$SELECT($PIECE($GET(^DG(43,1,9999999)),U,2)="Y":1,1:0)
+16 DO ^DIE
+17 KILL X
SET X=$$REPEAT^XLFSTR(" ",20)_"Done."
DO MES^XPDUTL(.X)
+18 QUIT
+19 ;
PARAM ;EP; copy ADT parameters from file 43 to 9009020.1
+1 ; old data to stay until future patch
+2 ; Copies only if site has parameters set already
+3 ;
+4 DO BMES^XPDUTL("Copying IHS ADT Parameter fields to new file...")
+5 ;
+6 NEW DIV,DATA,I,DIK
+7 ;no primary division
SET DIV=$PIECE($GET(^DG(43,1,"GL")),U,3)
IF 'DIV
QUIT
+8 ;already set up
IF $DATA(^BDGPAR(DIV,0))
QUIT
+9 ;
+10 SET ^BDGPAR(DIV,0)=DIV
SET $PIECE(^BDGPAR(0),U,3)=DIV
+11 SET $PIECE(^BDGPAR(0),U,4)=$PIECE(^BDGPAR(0),U,4)+1
+12 ;
+13 SET DATA=$GET(^DG(43,1,9999999))
IF DATA]""
Begin DoDot:1
+14 FOR I="5;5","6;2"
SET $PIECE(^BDGPAR(DIV,0),U,$PIECE(I,";",2))=$PIECE(DATA,U,+I)
End DoDot:1
+15 ;
+16 SET DATA=$GET(^DG(43,1,9999999.01))
IF DATA]""
Begin DoDot:1
+17 FOR I="1;10","2;1","3;2","4;3","5;4","6;6","7;8"
Begin DoDot:2
+18 SET $PIECE(^BDGPAR(DIV,1),U,$PIECE(I,";",2))=$PIECE(DATA,U,+I)
End DoDot:2
End DoDot:1
+19 ;
+20 SET DATA=$GET(^DG(43,1,9999999.02))
IF DATA]""
Begin DoDot:1
+21 FOR I="1;5;1","2;7;1","3;12;0","4;8;0"
Begin DoDot:2
+22 SET $PIECE(^BDGPAR(DIV,$PIECE(I,";",3)),U,$PIECE(I,";",2))=$PIECE(DATA,U,+I)
End DoDot:2
End DoDot:1
+23 ;
+24 ;IHS/ITSC/LJF 1/9/2004 convert Y/N answers to 1/0 answers
+25 SET DATA=$GET(^BDGPAR(DIV,1))
IF DATA]""
FOR I=1:1:14
Begin DoDot:1
+26 IF $PIECE(DATA,U,I)="Y"
SET $PIECE(DATA,U,I)=1
+27 IF $PIECE(DATA,U,I)="N"
SET $PIECE(DATA,U,I)=0
End DoDot:1
SET ^BDGPAR(DIV,1)=DATA
+28 ;
+29 ;IHS/ITSC/WAR 6/18/03 - Added code to update the 'VERSION' node in
+30 ; DG(43, This uses the 'C' xref in the pkg file.
+31 SET DATA=$$VERSION^XPDUTL("PIMS")
IF DATA]""
Begin DoDot:1
+32 SET ^DG(43,1,"VERSION")=DATA
End DoDot:1
+33 ;
+34 SET DIK="^BDGPAR("
DO IXALL^DIK
+35 KILL X
SET X=$$REPEAT^XLFSTR(" ",20)_"Done."
DO MES^XPDUTL(.X)
+36 QUIT
+37 ;
+38 ;IHS/ITSC/WAR 10/17/03 added - updates the ADT ver# in pkg file
+39 ;IHS/ITSC/LJF 1/16/2004 added more updates
PKGFILE ;EP
+1 NEW VER,BDGV,BDGN,X,DA,DIC,Y,DIE,DR
+2 IF $DATA(XPDNM)
SET VER=$$VER^XPDUTL(XPDNM)
+3 IF $GET(VER)]""
Begin DoDot:1
+4 ; update current version field
+5 SET BDGN=$ORDER(^DIC(9.4,"C","DG",0))
IF 'BDGN
QUIT
+6 SET ^DIC(9.4,BDGN,"VERSION")=VER
+7 ;
+8 ; clean up old 5.3 test versions
+9 SET BDGV=0
FOR
SET BDGV=$ORDER(^DIC(9.4,BDGN,22,"B",BDGV))
IF BDGV=""
QUIT
Begin DoDot:2
+10 IF BDGV["5.3"
IF BDGV'=5.3
Begin DoDot:3
+11 SET DIE="^DIC(9.4,"_BDGN_",22,"
SET DA(1)=BDGN
SET DR=".01///@"
+12 SET DA=$ORDER(^DIC(9.4,BDGN,22,"B",BDGV,0))
IF 'DA
QUIT
+13 DO ^DIE
End DoDot:3
End DoDot:2
+14 ;
+15 ; now add version multiple without test version #
+16 SET DIC="^DIC(9.4,"_BDGN_",22,"
SET DIC(0)="L"
SET X=5.3
+17 SET DIC("P")=$PIECE(^DD(9.4,22,0),U,2)
+18 SET DIC("DR")="2///"_DT_";3///`"_DUZ
SET DA(1)=BDGN
+19 DO ^DIC
End DoDot:1
+20 ;
+21 ;add patch history
DO PATCHES^BDGPOST5
+22 QUIT
CHRTDEF ;EP; copy chart deficiency items to new file
+1 ; ^ADGCD( -> ^BDGCD( will keep old data until future patch
+2 ;
+3 ;already has data
IF $ORDER(^BDGCD(0))
QUIT
+4 ;
+5 DO BMES^XPDUTL("Copying Chart Deficiency entries to new file...")
+6 NEW IEN,DIK
+7 SET IEN=0
FOR
SET IEN=$ORDER(^ADGCD(IEN))
IF 'IEN
QUIT
Begin DoDot:1
+8 ;bad entry
IF $GET(^ADGCD(IEN,0))=""
QUIT
+9 SET ^BDGCD(IEN,0)=^ADGCD(IEN,0)
End DoDot:1
+10 ;
+11 ; set zero node of file
+12 SET $PIECE(^BDGCD(0),U,3,4)=$PIECE(^ADGCD(0),U,3,4)
+13 ; index file
+14 SET DIK="^BDGCD("
DO IXALL^DIK
+15 KILL X
SET X=$$REPEAT^XLFSTR(" ",20)_"Done."
DO MES^XPDUTL(.X)
+16 QUIT
+17 ;
OLDFILES ;EP; change name of old files where new file uses same name
+1 DO BMES^XPDUTL("Changing name of obsolete files...")
+2 NEW DIE,DA,DR,X
+3 SET DIE="^DIC("
+4 FOR DA=9009011,9009011.5,9009013,9009013.1,9009013.5,9009015
Begin DoDot:1
+5 SET X=$PIECE($GET(^DIC(DA,0)),U)
IF X=""
QUIT
IF X["-OLD"
QUIT
+6 SET DR=".01///"_X_"-OLD"
+7 DO ^DIE
End DoDot:1
+8 KILL X
SET X=$$REPEAT^XLFSTR(" ",20)_"Done."
DO MES^XPDUTL(.X)
+9 QUIT
+10 ;
ADTTMPL ;EP; edit ADT Template entries that could not pass via KIDS
+1 DO BMES^XPDUTL("Fixing ADT Template entries...")
+2 NEW DGEDIT,DA,DIE,DR
+3 SET DGEDIT=""
SET DIE=43.7
+4 SET DA=2
SET DR="6///DG SI LIST"
DO ^DIE
+5 SET DA=3
SET DR="6///DG FEMALE INPATIENTS"
DO ^DIE
+6 KILL X
SET X=$$REPEAT^XLFSTR(" ",20)_"Done."
DO MES^XPDUTL(.X)
+7 QUIT
+8 ;
FACMOV ;EP; add new facility movement type (WARD TRANSFER ONLY)
+1 ; used when adding ward transfers non-interactively
+2 IF $DATA(^DG(405.1,"B","WARD TRANSFER ONLY"))
QUIT
+3 DO BMES^XPDUTL("Adding WARD TRANSFER ONLY to file 405.1...")
+4 NEW DIC,DD,DO,X,DLAYGO,DA,Y
+5 SET DIC="^DG(405.1,"
SET X="WARD TRANSFER ONLY"
SET DIC(0)="L"
SET DLAYGO=405.1
+6 SET DIC("DR")=".02///2;.03///INTERWARD TRANSFER;.04///1;.05///0"
+7 DO FILE^DICN
KILL DIC
+8 IF Y<1
KILL X
SET X=$$REPEAT^XLFSTR(" ",10)_"Error adding to file 405.1."
DO MES^XPDUTL(.X)
QUIT
+9 ;
+10 SET DIC="^DG(405.1,"_(+Y)_",""F"","
SET DA(1)=+Y
SET DIC(0)="L"
SET DLAYGO=405.11
+11 SET DIC("P")="405.11PA"
+12 FOR BDG=1:1:8
SET X=$PIECE($TEXT(MOV+BDG),";;",2)
DO ^DIC
+13 KILL X
SET X=$$REPEAT^XLFSTR(" ",20)_"Done."
DO MES^XPDUTL(.X)
+14 QUIT
+15 ;
MOV ;;
+1 ;;DIRECT;;
+2 ;;TRANS-NON IHS HOSPITAL;;
+3 ;;TRANS-IHS HOSPITAL;;
+4 ;;REFERRED FROM IHS CLINIC;;
+5 ;;OTHER;;
+6 ;;PROVIDER/SPECIALTY CHANGE;;
+7 ;;INTERWARD TRANSFER;;
+8 ;;WARD TRANSFER ONLY;;
+9 ;
+10 ;
TRSPEC ;EP; add treating specialty entries
+1 ; 1. add inpatient ones if not in file
+2 ; 2. add observation ones
+3 DO BMES^XPDUTL("Adding Observation Treating Specialties...")
+4 NEW IEN,CODE
+5 SET (DIC,DLAYGO)=45.7
SET DIC(0)="L"
+6 FOR BDGI=1:1:41
SET CODE=$PIECE($TEXT(TS+BDGI),";;",2)
Begin DoDot:1
+7 ;already has service
IF $ORDER(^DIC(45.7,"CIHS",CODE,0))
QUIT
+8 KILL DD,DO
SET X=$PIECE($TEXT(TS+BDGI),";;",3)
SET ABBRV=$PIECE($TEXT(TS+BDGI),";;",4)
+9 SET DIC("DR")="9999999.01///"_CODE_";99///"_ABBRV
DO FILE^DICN
End DoDot:1
+10 KILL X
SET X=$$REPEAT^XLFSTR(" ",20)_"Done."
DO MES^XPDUTL(.X)
+11 QUIT
+12 ;
TS ;; Inpatient Treating Specialties
+1 ;;01;;DENTAL;;DEN;;
+2 ;;02;;OTOLARYNGOLOGY;;ENT;;
+3 ;;03;;GENERAL MEDICINE;;GMED;;
+4 ;;04;;GENERAL SURGERY;;SUR;;
+5 ;;05;;GYNECOLOGY;;GYN;;
+6 ;;06;;INTERNAL MEDICINE;;IMED;;
+7 ;;07;;NEWBORN;;NEW;;
+8 ;;08;;OBSTETRICS;;OB;;
+9 ;;09;;OPHTHALMOLOGY;;EYE;;
+10 ;;10;;ORTHOPEDICS;;ORTHO;;
+11 ;;11;;PEDIATRICS;;PEDS;;
+12 ;;12;;PSYCHIATRIC MENTAL HEALTH;;PSYCH;;
+13 ;;13;;TUBERCULOSIS;;TB;;
+14 ;;14;;OTHER;;OTHER;;
+15 ;;15;;ALCOHOL/SUBSTANCE ABUSE;;ALCOH;;
+16 ;;16;;PLASTIC SURGERY;;PSUR;;
+17 ;;17;;FAMILY PRACTICE;;FAMP;;
+18 ;;18;;UROLOGY;;URO;;
+19 ;;19;;PODIATRY;;POD;;
+20 ;;20;;NEUROLOGY;;NEURO;;
+21 ;;21;;SWING BED;;SWING;;
+22 ;;22;;NURSE-MIDWIFERY SERVICE;;NRSMW;;
+23 ;;01O;;DENTAL OBSERVATION;;DENO;;
+24 ;;02O;;ENT OBSERVATION;;ENTO;;
+25 ;;03O;;MEDICINE OBSERVATION;;MEDO;;
+26 ;;04O;;SURGERY OBSERVATION;;SURO;;
+27 ;;05O;;GYN OBSERVATION;;GYNO;;
+28 ;;06O;;INTERNAL MED OBSERVATION;;IMEDO;;
+29 ;;08O;;OBSTETRICS OBSERVATION;;OBO;;
+30 ;;09O;;OPHTHALMOLOGY OBSERVATION;;EYEO;;
+31 ;;10O;;ORTHOPEDICS OBSERVATION;;ORTO;;
+32 ;;11O;;PEDIATRICS OBSERVATION;;PEDO;;
+33 ;;12O;;MENTAL HEALTH OBSERVATION;;MHO;;
+34 ;;13O;;TUBERCULOSIS OBSERVATION;;TBO;;
+35 ;;15O;;SUBSTANCE ABUSE OBSERVATION;;ALCOO;;
+36 ;;16O;;PLASTIC SURGERY OBSERVATION;;PSURO;;
+37 ;;17O;;FAMILY PRACTICE OBSERVATION;;FAMPO;;
+38 ;;18O;;UROLOGY OBSERVATION;;UROO;;
+39 ;;19O;;PODIATRY OBSERVATION;;PODO;;
+40 ;;20O;;NEUROLOGY OBSERVATION;;NEUOB;;
+41 ;;22O;;NURSE-MIDWIFERY OBSERVATION;;NRSOB;;
