- SR184UTL ;BIR/SJA - SR*3*184 UTILITY ROUTINE ;03/11/2015
- ;;3.0;Surgery;**184**;24 Jun 93;Build 35
- Q
- PRE ; pre-install process for SR*3*184
- ; delete data from file 136.5 and re-initialize file
- K ^SRO(136.5) S ^SRO(136.5,0)="PERIOPERATIVE OCCURRENCE CATEGORY^136.5I^^"
- Q
- POST ; post-install process for SR*3*184
- ; populate file 137
- N SRI,SRJ,SRL,SRLIST,SRX,SRY,X
- D MES^XPDUTL(" Populating CPT EXCLUSIONS file...")
- K ^SRO(137) S ^SRO(137,0)="CPT EXCLUSIONS^137P^^"
- F SRJ=0:1 S SRLIST=$P($T(LIST+SRJ)," ;;",2) Q:SRLIST="" F SRI=1:1 S SRX=$P(SRLIST,",",SRI) Q:SRX="" I $D(^ICPT("B",SRX)) D INT
- D PEX^SR184UT0,PEX^SR184UT1,PEX^SR184UT2,PEX^SR184UT3
- S SRX="A" F S SRX=$O(^ICPT("B",SRX)) Q:SRX="" D INT
- ;
- ; delete routines SR184UT0, SR184UT1,SR184UT2,and SR184UT3
- F X="SR184UT0","SR184UT1","SR184UT2","SR184UT3" X ^%ZOSF("TEST") I $T D
- . D MES^XPDUTL(" Deleting routine "_X_"...")
- . X ^%ZOSF("DEL")
- K DA,DIC,DD,DO,DINUM,X
- ;
- ; populate the CPT-Sipnal Level file #131.4
- F SRJ=0:1 S SRLIST=$P($T(SCPT+SRJ),";;",2) Q:SRLIST="END" F SRI=1:1 S SRX=$P(SRLIST,",",SRI) Q:SRX="" I $D(^ICPT("B",SRX)) D
- . S SRY=0,SRY=$O(^ICPT("B",SRX,SRY)) Q:SRY=""
- . K DA,DIC,DD,DO,DINUM S (DINUM,X)=SRY,DIC="^SRO(131.4,",DIC(0)="L" D FILE^DICN
- ;
- REMVOP ; Remove options from menu and place out of order
- N SRMN,SROP,CHK,SRII
- F SRII="SROMENU;SR TRANSPLANT ASSESSMENT","SROA CARDIAC ENTER/EDIT;SROA CARDIAC-OUTCOMES" S SRMN=$P(SRII,";"),SROP=$P(SRII,";",2) D
- . S CHK=$$DELETE^XPDMENU(SRMN,SROP)
- . D BMES^XPDUTL(">>> "_SROP_" option "_$S(CHK:"has been removed from ",1:"does not exist in ")_SRMN_" <<<")
- . D OUT^XPDMENU(SROP,"Not used after patch SR*3*184")
- ;
- ; update identifier code for file #135
- S ^DD(135,0,"ID",1)="D EN^DDIOL($P(^(0),U,2),"""",""?41"")"
- Q
- INT S SRY=0,SRY=$O(^ICPT("B",SRX,SRY)) Q:SRY=""
- K DA,DIC,DD,DO,DINUM S (DINUM,X)=SRY,DIC="^SRO(137,",DIC(0)="L" D FILE^DICN
- Q
- SCPT ;;0092T,0095T,0098T,0171T,0172T,0202T,0213T,0214T,0215T,0216T,0217T,0218T,0219T,0220T,0221T
- ;;0222T,0228T,0229T,0230T,0231T,0274T,0275T,0282T,0283T,0284T,0285T,0309T,0334T,0375T,20664
- ;;20930,20931,20936,20937,20938,22010,22015,22100,22101,22102,22103,22110,22112,22114,22116
- ;;22206,22207,22208,22210,22212,22214,22216,22220,22222,22224,22226,22318,22319,22325,22326
- ;;22327,22328,22510,22511,22512,22513,22514,22515,22520,22521,22523,22524,22525,22526,22527
- ;;22532,22533,22534,22548,22551,22552,22554,22556,22558,22585,22586,22590,22595,22600,22610
- ;;22612,22614,22630,22632,22633,22634,22800,22802,22804,22808,22810,22812,22818,22819,22830
- ;;22840,22841,22842,22843,22844,22845,22846,22847,22848,22849,22850,22851,22852,22855,22856
- ;;22857,22858,22861,22862,22864,22865,22899,27279,62267,62269,62270,62272,62273,62280,62281
- ;;62282,62284,62287,62290,62291,62292,62310,62311,62318,62319,62350,62351,62355,62360,62361
- ;;62362,62365,62367,62368,63001,63003,63005,63011,63012,63015,63016,63017,63020,63030,63035
- ;;63040,63042,63043,63044,63045,63046,63047,63048,63050,63051,63055,63056,63057,63064,63066
- ;;63075,63076,63077,63078,63081,63082,63085,63086,63087,63088,63090,63091,63101,63102,63103
- ;;63170,63172,63173,63180,63182,63185,63190,63191,63194,63195,63196,63197,63198,63199,63200
- ;;63250,63251,63252,63265,63266,63267,63268,63270,63271,63272,63273,63275,63276,63277,63278
- ;;63280,63281,63282,63283,63285,63286,63287,63290,63295,63300,63301,63302,63303,63304,63305
- ;;63306,63307,63308,63600,63610,63615,63650,63655,63661,63662,63663,63664,63685,63688,63700
- ;;63702,63704,63706,63707,63709,63710,63740,63741,63744,63746,64490,64491,64492,64493,64494,64495
- ;;END
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSR184UTL 3642 printed Mar 13, 2025@21:43:28 Page 2
- SR184UTL ;BIR/SJA - SR*3*184 UTILITY ROUTINE ;03/11/2015
- +1 ;;3.0;Surgery;**184**;24 Jun 93;Build 35
- +2 QUIT
- PRE ; pre-install process for SR*3*184
- +1 ; delete data from file 136.5 and re-initialize file
- +2 KILL ^SRO(136.5)
- SET ^SRO(136.5,0)="PERIOPERATIVE OCCURRENCE CATEGORY^136.5I^^"
- +3 QUIT
- POST ; post-install process for SR*3*184
- +1 ; populate file 137
- +2 NEW SRI,SRJ,SRL,SRLIST,SRX,SRY,X
- +3 DO MES^XPDUTL(" Populating CPT EXCLUSIONS file...")
- +4 KILL ^SRO(137)
- SET ^SRO(137,0)="CPT EXCLUSIONS^137P^^"
- +5 FOR SRJ=0:1
- SET SRLIST=$PIECE($TEXT(LIST+SRJ)," ;;",2)
- if SRLIST=""
- QUIT
- FOR SRI=1:1
- SET SRX=$PIECE(SRLIST,",",SRI)
- if SRX=""
- QUIT
- IF $DATA(^ICPT("B",SRX))
- DO INT
- +6 DO PEX^SR184UT0
- DO PEX^SR184UT1
- DO PEX^SR184UT2
- DO PEX^SR184UT3
- +7 SET SRX="A"
- FOR
- SET SRX=$ORDER(^ICPT("B",SRX))
- if SRX=""
- QUIT
- DO INT
- +8 ;
- +9 ; delete routines SR184UT0, SR184UT1,SR184UT2,and SR184UT3
- +10 FOR X="SR184UT0","SR184UT1","SR184UT2","SR184UT3"
- XECUTE ^%ZOSF("TEST")
- IF $TEST
- Begin DoDot:1
- +11 DO MES^XPDUTL(" Deleting routine "_X_"...")
- +12 XECUTE ^%ZOSF("DEL")
- End DoDot:1
- +13 KILL DA,DIC,DD,DO,DINUM,X
- +14 ;
- +15 ; populate the CPT-Sipnal Level file #131.4
- +16 FOR SRJ=0:1
- SET SRLIST=$PIECE($TEXT(SCPT+SRJ),";;",2)
- if SRLIST="END"
- QUIT
- FOR SRI=1:1
- SET SRX=$PIECE(SRLIST,",",SRI)
- if SRX=""
- QUIT
- IF $DATA(^ICPT("B",SRX))
- Begin DoDot:1
- +17 SET SRY=0
- SET SRY=$ORDER(^ICPT("B",SRX,SRY))
- if SRY=""
- QUIT
- +18 KILL DA,DIC,DD,DO,DINUM
- SET (DINUM,X)=SRY
- SET DIC="^SRO(131.4,"
- SET DIC(0)="L"
- DO FILE^DICN
- End DoDot:1
- +19 ;
- REMVOP ; Remove options from menu and place out of order
- +1 NEW SRMN,SROP,CHK,SRII
- +2 FOR SRII="SROMENU;SR TRANSPLANT ASSESSMENT","SROA CARDIAC ENTER/EDIT;SROA CARDIAC-OUTCOMES"
- SET SRMN=$PIECE(SRII,";")
- SET SROP=$PIECE(SRII,";",2)
- Begin DoDot:1
- +3 SET CHK=$$DELETE^XPDMENU(SRMN,SROP)
- +4 DO BMES^XPDUTL(">>> "_SROP_" option "_$SELECT(CHK:"has been removed from ",1:"does not exist in ")_SRMN_" <<<")
- +5 DO OUT^XPDMENU(SROP,"Not used after patch SR*3*184")
- End DoDot:1
- +6 ;
- +7 ; update identifier code for file #135
- +8 SET ^DD(135,0,"ID",1)="D EN^DDIOL($P(^(0),U,2),"""",""?41"")"
- +9 QUIT
- INT SET SRY=0
- SET SRY=$ORDER(^ICPT("B",SRX,SRY))
- if SRY=""
- QUIT
- +1 KILL DA,DIC,DD,DO,DINUM
- SET (DINUM,X)=SRY
- SET DIC="^SRO(137,"
- SET DIC(0)="L"
- DO FILE^DICN
- +2 QUIT
- SCPT ;;0092T,0095T,0098T,0171T,0172T,0202T,0213T,0214T,0215T,0216T,0217T,0218T,0219T,0220T,0221T
- +1 ;;0222T,0228T,0229T,0230T,0231T,0274T,0275T,0282T,0283T,0284T,0285T,0309T,0334T,0375T,20664
- +2 ;;20930,20931,20936,20937,20938,22010,22015,22100,22101,22102,22103,22110,22112,22114,22116
- +3 ;;22206,22207,22208,22210,22212,22214,22216,22220,22222,22224,22226,22318,22319,22325,22326
- +4 ;;22327,22328,22510,22511,22512,22513,22514,22515,22520,22521,22523,22524,22525,22526,22527
- +5 ;;22532,22533,22534,22548,22551,22552,22554,22556,22558,22585,22586,22590,22595,22600,22610
- +6 ;;22612,22614,22630,22632,22633,22634,22800,22802,22804,22808,22810,22812,22818,22819,22830
- +7 ;;22840,22841,22842,22843,22844,22845,22846,22847,22848,22849,22850,22851,22852,22855,22856
- +8 ;;22857,22858,22861,22862,22864,22865,22899,27279,62267,62269,62270,62272,62273,62280,62281
- +9 ;;62282,62284,62287,62290,62291,62292,62310,62311,62318,62319,62350,62351,62355,62360,62361
- +10 ;;62362,62365,62367,62368,63001,63003,63005,63011,63012,63015,63016,63017,63020,63030,63035
- +11 ;;63040,63042,63043,63044,63045,63046,63047,63048,63050,63051,63055,63056,63057,63064,63066
- +12 ;;63075,63076,63077,63078,63081,63082,63085,63086,63087,63088,63090,63091,63101,63102,63103
- +13 ;;63170,63172,63173,63180,63182,63185,63190,63191,63194,63195,63196,63197,63198,63199,63200
- +14 ;;63250,63251,63252,63265,63266,63267,63268,63270,63271,63272,63273,63275,63276,63277,63278
- +15 ;;63280,63281,63282,63283,63285,63286,63287,63290,63295,63300,63301,63302,63303,63304,63305
- +16 ;;63306,63307,63308,63600,63610,63615,63650,63655,63661,63662,63663,63664,63685,63688,63700
- +17 ;;63702,63704,63706,63707,63709,63710,63740,63741,63744,63746,64490,64491,64492,64493,64494,64495
- +18 ;;END
